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9.  4ppendix  D:  common  program  source 

FILE:  Common/Makefile 


# 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


default:  common 


CC  =  cc  -g 
INCLUDE  =  include 
CFLAGS  =  -1$ (INCLUDE) 
LIBRARY  =  library/library . a 


OBJECTS  =  \ 

S  (INCLUDE) /grammar. h  \ 
•grammar. [co]  \ 
•scanner. [co]  \ 
yytrace. [co]  \ 
y . output 


PROGRAMS  =  \ 
•common 


grammar. c:  grammar. y 
yacc  -dv  grammar. y 
mv  y.tab.h  S ( INCLUDE) /grammar . h 
mv  y.tab.c  grammar. c 


scanner. c-  scanner. 1 

lex  -vt  scanner. 1  |  sed  '  s/getc/yygetc/ '  >scanner.c 


scanner. o:  scanner. c 

S (CC)  S  (CFLAGS)  -c  scanner. c 

grammar.o:  grammar.c 

$(CC)  S (CFLAGS)  -c  grammar.c 

common:  grammar.o  scanner. o  S (LIBRARY) 

$(CC)  -c  common  grammar.o  scanner. o  S (LIBRARY) 


sgrammar .  c:  grammar . c  yytoken.awk 

awk  -f  yytoken.awk  kgrammar.c  >sgrammar.c 

sgrammar.o: sgrammar. c 

S (CC)  S (CFLAGS)  -c  sgrammar. c 

scommon:  sgrammar.o  scanner. c  S (LIBRARY! 

$ (CC)  -o  scommon  sgrammar.o  scanner. o  S (LIBRARY) 


dscanner.c:  scanner. c 

cp  scanner. c  dscanner.c 

dscanner.o: dscanner.c  S (INCLUDE) /grammar . h 
$(CC)  S (CFLAGS)  -CCZBUG  -c  dscanner.c 

dcommon:  grammar.o  dscanner.o  S (LIBRARY) 

S (CC)  -o  dcommon  grammar.o  dscanner.o  S (LIBRARY) 


t g: amma  r . c : gramma  r . c 

sed  ' s/yy stack :/ s  yyt race (yystate) ; / '  <grammar.c  >tgramma 


tgrammar.o: tgrammar.c 

S(CC)  S (CFLAGS)  -c  tgrammar.c 
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tcommon:  tgrammar.o  scanner. o  yytrace.o  5 (LIBRARY) 

$(CC)  -o  tcommon  tgrammar.o  scanner. o  yytrace.o  5 (LIBRARY) 


yytra_e.c:  grammar. c  yytrace.awk 

awk  -f  yytrace.awk  <y. output  >yytrace.c 

yytrace.o:  yytrace.c 

S(CC)  $ (CFLAGS)  -c  yytrace.c 


clean: 

cd  library;  make  clean 
rm  -f  $ (PROGRAMS)  $ (OBJECTS) 


FILE:  common /gramma r . y 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*  / 


/* 

*  FORTRAN  11 

*/ 


%token  RW_AND 
%token  RW_ASSIGN 
♦token  RW_BACKSFACE 
♦token  RW_BLOCK_DATA 
♦token  RW_CALL 
♦token  RW  CHARACTER 
♦token  RW_CLOSE 
♦token  RW_COMMON 
♦token  RW_COMPLEX 
♦token  RW  CONTINUE 
♦token  RW~DATA 
♦token  RW_DIMENSION 
♦token  RW^DO 

♦token  RW_DOUBLE_PRECISION 

♦token  RW~ELSE 

♦token  RW^ELSE  IF 

♦token  RW_END 

♦token  RW~END_IF 

♦token  RW_ENDFILE 

♦token  RW_ENTRY 

♦token  RW_EQ 

♦token  RW_EQU I VALENCE 

♦token  RW_EQV 

♦token  RW_EXTERNAL 

♦token  RW_FALSE 

♦token  RW_FORMAT 

♦token  RW_FUNCTION 

♦token  RW_GE 

♦token  RW_GO_TO 

♦token  RW_GT 

♦token  RW_IF 

♦token  RW_IMPLICIT 

♦token  RW  INCLUDE 

♦token  RW^INQUIRE 

♦token  RW_INTEGER 

♦token  RW^ INTRINSIC 

♦token  RW_LE 

♦token  RW_LOGICAL 

♦token  RW  LT 

♦token  RW^NAMELIST 

♦token  RW_NE 

♦token  RW_NEQV 

♦token  RW_NOT 

♦token  RW_OPEN 

♦token  RW_OR 

♦token  RW_PARAMETER 

♦token  RW_PAUSE 

♦token  RW_PRINT 

♦token  RW  PROGRAM 
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%token  RW_R£AD 
%token  RW_R£AL 
%token  RWRETURN 
»tokcn  RW_REWIND 
%token  RW_SAVE 
%token  RW_STOP 
%token  RW_SUBRGUTI NE 
%token  RW_THEN 
%token  RW_TO 
%token  RW_TRUE 
%token  RW_WRITE 
%token  RW  UNDEFINED 


%token  COMMENT 
%tok2n  CONCATENATE 
%token  DOUBLE_PRECISION 
%token  EXPONENTIATE 
%token  HOLLERITH 
%token  IDENTIFIER 
%token  INTEGER 
%token  LABEL 
%token  REAL 
%token  STRING 


%left  • , ' 

%nonassoc  ' : 1 
%right  '=' 

%left  RW_EQV  RW_NEQV 
%lef t  RW_OR 
%left  RW_AND 
%left  RW_NOT 

%nonassoc  RW_EQ  RW_NE  RW  LT  RW_LE  RW_GT  RW_GE 
%lef t  CONCATENATE 
%lef t  ’+• 

%lef t  '*•  •/■ 

%right  EXPONENTIATE 
%lef C  SIGN 


%( 

typedef  char  ‘POINTER; 
#def ine  YYSTYPE  POINTER 


((include  "list.h" 
LIST*  clist  -  0; 


char  *block_name  =  0; 
char  ‘common  name  =  0; 


extern  POINTER 
extern  POINTER 
extern  POINTER 
extern  POINTER 
extern  POINTER 
%> 


duplicate ( 
merge (  ) ; 
list!  ) ; 
type  (  ) ; 
repl i cate ( 


)  ; 


)  ; 


%% 


program : 

opt ional_rt  atement_l i st 


optional  statement_l i st : 
r*  NULL  */ 

I 

statement  list 


st atement_l 1st: 

statement 


statement  1 L  st 


t a tement 
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statement : 

comment _statement 

label  unlabeled  statement 


comment_statement : 
COMMENT 


label : 

LABEL 


unlabeled_statement : 

include_statement 

I 

program_statement 

I 

block_data_statement 

I 

f unct ion_statement 

) 

subrout ine_s tat ement 
I 

entry_statement 

I 

end^st at ement 
I 

sped  fi  cat  ion_st  at  ement 

I 

executable_s tat ement 

I 

format  statement 


incl 


ude 


statement : 

RW  INCLUDE  character 


constant 


program_statement : 

RW_PROGRAM  program_ident i f ie r 


program_ident i f ier : 

IDENTIFIER 

{ 

$$  =  block_name  -  SI; 

) 


block_data_statement : 

RW  BLOCK  DATA  block  data  identifier 


block_data_ident i f ier : 

IDENTIFIER 

< 

$$  =  block  name  =  SI; 


function_statement : 

RW^FUNCTION  funct ion_identi f ier  optional  formal  argument  list 
type  RW_FUNCTION  f unct ion_i dent i f ie r  optional  formal  argument 


function_identifier: 

IDENTIFIER 
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SS  =  biockname  =  31; 

) 


subroutine  statement: 

RW  SUBROUTINE  subroutine  identifier 

RW_SUBROUTINE  sub rout i ne_i dent ifier  optional _f ormal_a rgumenti i st 


subrout i ne_ident i £ ier : 

IDENTIFIER 

f 

S3  -  block_name  -  SI; 

) 


entry_statement : 

RW_ENTRY  ent ry_ident i f ier 

RW_ENTRY  ent ry_ident 1  £ ; e r  opt i onai _£orma l_ar gument_l i st 


entry_ identifier: 

IDENTIFIER 

< 

SS  =  SI; 

) 


optional  formal_argument_list : 

•-(  '  '  )  ‘ 

( 

SS  =  0; 

} 

'('  forma  1 _a rgument _i i st  *)' 

I 

SS  =  S2; 

) 


f ormal_a rgument _1 i st : 

formal_a rgument 

( 

S3  =  merge)  "  i%s!“,  SI  ); 

} 

\ 

formal_argument_l i st  forma  1 _a rgument 

( 

S3  =  merge)  ”%s)%s}" ,  SI,  S3  ); 

I 


formal_argument : 

IDENTIFIER 

( 

SS  -  SI; 

I 

I 

f o rma l_a rgument _alternate_ret urn 

f 

SS  -  SI; 

) 


f orma l_a  rgumen t_a Iternatereturn: 

•  *  • 

$$  =  duplicate*  ); 
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end  statement: 

RW_ENL- 

pr  i  n :  _  1  i  s t  (  disc,  b 1 o ~ k _  name  • 
de  Lete_l  i  st  (  cdst  ); 

disc  =  0  ; 
block  name  -  0; 

spec:  f  :  c  a  c  i  o  n _  s c  a  c  erne r.  t  : 

external  _st at ement 

intrinsic  statement 

parai.  iter_stat ement 

dimension  statement 

declaration_  '  t 

sa ve_st a cement 

common_st  at ement 

equi valence_statement 

implicit  statement 

dat a_s tat ement 

n.arnel  i st_ statement 

externa'  statement: 

RW_EXTERNAL  ext e  r r.a  1  _i  i  s t 

externa  1 ^1 l st : 

externa  1 

$$  =  merge {  "«%s»" ,  SI  ); 

external  list  external 

S  $  -  rr>' ::  (  M  %  s  ,  %  s  ■  " ,  $  1  ,  5  j  )  ; 

f 

exte  rna  1  : 

i dent: 

$$ 

Lntrin  si  (restatement: 

RW  INTRINSIC  intrinsic  list 

int'insiclist : 

intrinsic 

i 

3  3  =  me^ge{  SI  ); 

) 

mtrinsic_lirt  ’  intrinsic 

$  $  =  me  rge  (  "  i  s  {  %  s  •  " ,  31,  S3  )  ; 
v 
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intrinsic: 

IDENTIFIER 

< 

SS  =  SI; 

1 


parameter_statement : 

RW_PARAMETER  '('  parameter_l 1st 


paramete  r  1 i st : 

parameter 

{ 

SS  =  merge!  SI  ); 

) 

pa rameter_l ist  parameter 

( 

SS  =  merge!  ,  SI,  S3  ); 

) 


parameter : 

IDENTIFIER  1 ='  expression 

{ 

$$  =  merge!  ”(%s)(%s)",  SI,  S3  ); 


dimension_statement : 

RW_DIMENSION  dimension  list 


dimens ion_l i st : 

dimension 

< 

SS  =  merge (  ” ( %s ) ",  Si  )  ; 

1 

I 

dimensional i st  dimension 

( 

SS  =  merge!  "%s(%s(",  SI,  S3  I  ; 

) 


dimension : 

IDENTIFIER  '('subscript  list  ')' 

{ 

SS  =  merge!  "(%s)(*s)",  si,  S3  ); 

} 


subscript^ list: 

subscript 

i 

SS  =  merge!  "its;”,  SI  ); 

t 

subscr i pt _1 i st  ' , ’  subscript 
( 

SS  *  merge!  "tsUs)",  Si,  S3  )  ; 

l 


subscr i pt : 

upper  bound 

i 

SS  =  Si; 

j 


lower  bound  upper  bound 
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{ 

SS  =  merge (  "%s:%s",  SI,  S3  ); 

} 


lower_bound: 

expression 

( 

SS  =  SI; 

) 


upper_bound: 

expression 

I 

SS  =  SI; 

) 

I 

upper_bound_ad jus table 

{ 

SS  =  $1; 

1 


upper_bound_ad justable : 

I  *  I 

{ 

SS  =  duplicate  (  •'*"  ); 

) 


declaration_statement : 

type  declaration_list 


declaration_list : 

declaration 

{ 

SS  =  merge  (  "(%s)'\  SI  )  ; 

1 

I 

declaration_list  declaration 

i 

SS  =  merge (  "%s(%s)",  SI,  S3  ); 

} 


declaration: 

IDENTIFIER 

< 

SS  =  merge (  "(%sf",  SI  ) ; 

1 

I 

IDENTIFIER  '('  subscript_list  ')' 

( 

SS  -  merge!  "(%s))%s|",  SI,  S3  )  ,- 

} 


type: 

type_name  optional_type_length 
SS  =  type  (  SI,  S2  ) ; 

) 


type_name : 

RW_CHARACTER 

( 

SS  =  duplicate!  "CHARACTER"  ) ; 

I 


RW  COMPLEX 
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{ 

SS  =  duplicate  (  "COMPLEX"  ); 

) 

RW_DOUBLE_PRECISION 

i 

$$  =  duplicate (  "DOUBLE_PRECISION"  ); 

) 

RW_INTEGER 

{ 

SS  =  duplicate!  "INTEGER"  ); 
i 

':-N_LOGICAL 

( 

$S  =  duplicate!  "LOGICAL"  ); 

1 

RW_REAL 

( 

$$  =  duplicate!  "REAL"  ); 
i 

RW_UNDEFINED 

( 

$$  =  duplicate!  "UNDEFINED"  ); 

1 


optional_type_length : 
/*  NULL  */ 

( 

$$  =  0; 

) 

type_length 

{ 

SS  =  SI; 

) 


type_length: 

'*’  INTEGER 

{ 

SS  -  S2; 

) 

I 

type_length_ad justable 

( 

SS  =  S2; 

> 


type_length_ad justable : 

•  ( '  1  *  '  •  )  ' 

< 

SS  =  duplicate!  ”(*)”  ); 

) 


save_stateraent : 

RW_SAVE  opt ional_save_l i st 


optional  save_list: 

/*  null  */ 

I 

SS  =  0; 

} 

I 

save_l i st 

( 

SS  =  SI; 

) 
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save_l i st : 

save 

( 

$$  =  merge (  "(%s)" ,  $1  ); 

} 

I 

save_list  save 

( 

$$  =  merge  (  "%s(%s}'\  SI,  S3  ); 

1 


save  : 

IDENTIFIER 

( 

$$  =  SI; 


I 

common_name 

1 

S$  =  51; 

) 


common_statement : 

RW_C0MM0N  optional_common_name  common_variable_list 

1 

common_name  =  0; 

1 


optional  common_narre: 

/*  NULL  */ 

{ 

$$  =  common_name  *  0; 

1 

I 

common_name 

1 

SS  =  common_name  =  51; 

1 


common_name : 

’/’  optional_identifier  '/' 

( 

SS  =  52; 

1 


optional  identifier: 
/"*  NULL  */ 

( 

SS  =  0; 

1 

I 

IDENTIFIER 

{ 

SS  =  51; 

) 


common_variable_list : 

common_variable 

( 

55  =  mergef  "(%s)",  $1  ); 

1 

I 

common_variable_l i st  common_variable 

( 

SS  =  merge;  "%s(%s)n,  SI,  S3  ); 

) 
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common_variable : 

IDENTIFIER 

{ 

add_list (  Sclist,  common_name, 
$$  =  merge!  $1  ) ; 

1 

I 

IDENTIFIER  '('  subscript_Iist  ')' 

{ 

add_list(  Sclist,  common_name , 
$$  =  merge)  “ (%s}{%s}",  $1,  S3 

} 


equivalence_statement : 

RW_EQUIVALENCE  equivalence_list 


equi valence_l i st : 

equivalence 

{ 

$  $  =  me rge (  " ( %  s ( ” ,  SI  ) ; 

) 

I 

equivalence_list  equivalence 

{ 

$S  =  merge!  "%s(%s|",  SI,  S3  ); 

1 


equivalence : 

'('  variablelist  * ) * 

( 

SS  =  S2; 

) 


variable_list : 

variable 

( 

SS  =  merge!  $1  ); 

} 

I 

variable_list  variable 

( 

SS  =  merge!  11  %s(%s)n,  SI,  S3  ); 

) 


impl icit_statement : 

RW_IMPLICIT  type  ' (’  implicit_list 


implicit_list : 

implicit 

( 

$  $  =  merge!  "  (  %  s )  " ,  SI  )  ; 

} 

I 

impl i ci t_l i s t  implicit 

I 

SS  •  merge!  "%s(%s)",  SI,  S3  ); 

) 


implicit : 

IDENTIFIER 

! 

SS  =  merge!  "(%s}",  SI  ) ; 

) 


$1  )  ; 


SI  )  ; 
)  ; 


IDENTIFIER  IDENTIFIER 
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( 

$$  =  merge)  "(%s)(%st",  31,  53  ); 

} 


namei i st_st atement : 

RW  NAMELIST  namelist  name  namelist  list 


namelist  name: 

V'  IDENTIFIER 

{ 

$$  =  32; 

1 


namelist_list : 

namelist 

( 

S3  =  merge {  "(%s)n,  $1  ) ; 

1 

I 

namelist_list  namelist 

{ 

S3  =  merge (  "  %  s  (  %  s  |  " ,  31,  S3  ); 

i 


namelist: 

IDENTIFIER 

{ 

S3  =  31; 

) 


data_statement : 

RW  DATA  data  list 


data_list : 

data 

{ 

S3  =  merge)  ")%sl",  31  ) ; 

1 

I 

data_list  optional_comma  data 

( 

S3  =  merge)  "%s(%s(",  31,  S3  ); 

) 


data : 

data_variable_list  '/'  data_constant_list  */' 

< 

S3  =  merge)  n(%s){»s|",  31,  S3  ) ; 

1 


data_variable_list : 

data_variable 

{ 

3  3  =  me rge (  " ( %  s }  " ,  31  )  ; 

) 

I 

data_uariable_l  i st  data_variable 

1 

S3  =  merge)  "%s(%s}",  SI,  S3  >; 

) 


data_variable : 

variable 
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< 

SS  =  SI; 

) 

data_implied_do_list 

{ 

$$  =  SI; 

1 


data_impl ied_do_list : 

'('  data_variab. e_list  IDENTIFIER  '=*  expression_lis 

{ 

SS  =  merge  " (  %s,  %s  =  %s  )",  list!  S2,  ",  "  ),  SI, 

) 


data_constant_list : 

data_constant 

( 

$$  =  me-ge!  "{%s}",  SI  ); 

} 

I 

data_constant_list  data_constant 

( 

SS  -  merge (  ”%s(%s}",  SI,  S3  , ; 

1 


data_constant : 

data_initialization 

( 

SS  =  $1; 

) 

I 

IDENTIFIER  data_initial izat ion 

( 

SS  =  merge!  "%s  *  %s",  SI,  S3  )  ; 

1 

I 

INTEGER  data_inir.ialization 

{ 

SS  =  replicate!  atoi  (  SI  ),  S3,  " 1 ( "  ); 

1 


data  initialization: 

IDENTIFIER 

( 

SS  =  51; 

) 

I 

character_constant 

{ 

SS  =  SI; 

I 

I 

logical_constant 

( 

SS  =  SI; 

) 

I 

signed_numerical_constant 

! 

SS  =  SI; 

) 


signed_numerical_constant : 

numerical_constant 

( 

SS  =  SI; 

1 

I 

1 +'  numerical_constant  %prec  SIGN 
( 


■ )  * 

list  (  S6,  ",  "  )  )  ; 
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$  S  =  me  rge  (  "  +  %  s  " ,  52  I  ; 

) 

numerical_constant  %prec  SIGN 

{ 

S S  =  merge!  " - % s “ ,  S 2  )  ; 

} 


expression: 

parentbesis_expression 

{ 

55  =  SI; 

1 

I 

simple_expression 

( 

SS  -  SI; 

) 


parenthesis_expression: 

' ( '  expression  ' ) ' 

{ 

S  S  =  me  rge  (  “  (  %  s  )  " ,  $2  )  ; 

1 


simple_expression: 

variable 

1 

SS  =  SI; 

1 

I 

constant 

{ 

SS  =  SI; 

) 

I 

arithmet ic_expression 

( 

SS  =  SI; 

1 

I 

character_expression 

1 

SS  =  SI; 

1 

I 

relational_expression 

( 

SS  «  SI; 

) 

I 

logical_expression 

{ 

SS  =  SI; 

1 

I 

unary_expression 

1 

SS  =  SI; 

) 


var iable : 

IDENTIFIER 

( 

usage_list(  clist,  SI  ); 
SS  -  SI; 

) 

I 

IDENTIFIER  st r i ng_subset 

( 

usage_list(  clist,  SI  ); 
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5?  =  merge!  "%s%s",  $1,  S2  ); 

1 

array 

( 

S$  =  SI; 

) 


array : 

IDENTIFIER  '('  optional_expression_list  ')■ 

( 

usage_list(  disc,  $1  ); 

S$  =  merge!  "%s(%s)",  $1,  list!  S3,  ”,  "  )  ); 

} 

I 

IDENTIFIER  '('  optional_expression_list  string_subset 

( 

usage_list(  clist,  SI  ); 

S$  =  merge!  "%s(%s)%s”,  SI,  list!  $3,  ",  "  ) ,  $5  ) ; 

> 


optional  expression_list: 
r*  NULL  */ 

{ 

SS  =  0; 

1 

I 

expression_list 

( 

SS  =  SI; 

1 


cxnression_list ; 

expression 

( 

SS  =  merge!  •■  {  %  s }  •* ,  $1  )  ; 
l 
I 

expression_list  expression 

( 

SS  =  merge!  "%s(»sj",  SI,  $3  ); 

) 


st  ring_subset : 

'('  opt ional_expression  optional  expression  ')' 

( 

SS  =  merge!  "  (  %s  :  %s  )  ",  S2,  S4  ); 

) 


opt ional_expression : 
,  *  NULL  */ 

< 

SS  =  0; 

1 

I 

expression 

( 

$$  =  *1; 

) 


constant : 

character_constant 

f 

SS  =  SI; 


} 


I 


logicai_constant 


16 


Annual  Report:  Digital  Emulation  Technology  Laboratory  Volume  1,  Part  2 


( 

$$  =  $1; 

) 

numerical_constant 

t 

$$  =  SI; 

1 


character_constant : 
HOLLERITH 
1 

SS  =  SI; 

1 

I 

STRING 

1 

$S  =  SI; 

1 


logical_constant : 

RW_FALSE 

( 

SS  -  duplicate (  ".FALSE."  ); 

1 

RW_TRUE 

{ 

SS  =  duplicate (  ".TRUE."  ); 

1 


numerical_constant : 

DOUBLE_PRECISION 

( 

SS  =  SI; 

1 

I 

INTEGER 

( 

SS  =  SI; 

1 

I 

REAL 

( 

SS  =  SI; 

1 


arithmetic_expression : 

expression  '+'  expression  %prec  '+• 

( 

SS  =  merge!  “%s  +  %s",  SI,  S3  ); 

1 

I 

expression  expression  %prec 

{ 

SS  -  merge!  "%s  -  »s",  SI,  S3  ); 

1 

I 

expression  1,1  expression  %prec 
f 

SS  =  merge!  "%s  *  %s",  SI,  S3  ); 
t 
I 

expression  '/'  expression  %prec  */' 

f 

SS  =  merge!  "%s  /  %s",  SI,  S3  ); 

) 

I 

expression  EXPONENTIATE  expression  %prec  EXPONENTIATE 

1 

SS  =  merge!  "%s  **  %s",  SI,  S3  ); 

1 
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cbaracCer_expression : 

expression  '/'  '/'  expression  iprec  CONCATENATE 

{ 

$5  =  merge!  "%s  //  %s",  SI,  $4  >; 

) 


reiat ional_expression : 

expression  RW_EQ  expression  %prec  RW_EQ 

( 

S$  =  merge!  "Ss  .EQ.  %s'\  SI,  S3  ); 

I 

| 

expression  RW__NE  expression  %prec  RW_NE 

{ 

S$  =  merge!  "*s  .NE.  %s",  $1,  S3  ); 

) 

I 

expression  RW_LT  expression  %prec  RW_LT 

{ 

SS  =  merge!  "%s  .LT.  %s",  SI,  S3  ); 

1 

I 

expression  RW_LE  expression  %prec  RW_LE 
( 

SS  =  merge!  ”%s  . LE.  %s",  SI,  S3  ); 

1 

I 

expression  RW_GT  expression  %prec  RW_GT 

{ 

SS  =  merge!  "%s  .GT.  %s",  SI,  $3  ); 

1 

I 

expression  RW  GE  expression  Spree  RW_GE 

{ 

SS  =  merge!  "%s  .GE.  %s",  SI,  $3  ); 

) 


logical_expression : 

expression  RW  AND  expression  %prec  RW_AND 

( 

$$  =  merge!  "Ss  .AND.  %s",  SI,  S3  ); 

1 

I 

expression  RW  OR  expression  Spree  RW_OR 

( 

SS  =  merge!  "%s  .OR.  %s",  SI,  S3  ) ; 

) 

i 

expression  RW_EQV  expression  %prec  RW__EQV 

{ 

SS  =  merge!  "%s  .SQV.  %s".  Si,  S3  ); 

J 

I 

expression  RW  NEQV  expression  Spree  RW_NEQV 

( 

SS  *  merge!  "%»  .NEQV.  %s".  Si,  S3  ); 

) 


unary_expression : 

'+'  expression  %prec  SIGN 

( 

SS  =  merge!  "aAs",  S2  ); 

1 

I 

expression  %prec  SIGN 
I 

SS  =  merge!  "-%s“,  S.  ); 

) 

RW_NOT  expression  Spree  RW  NOT 
( 

SS  =  merge!  ".NOT.  %s" ,  S2  ); 

) 
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executable_statement : 

do_statement 

I 

logical_i f_statement 

I 

block_i f_statement 

I 

else_statement 

l 

else_if_statement 

I 

end  if_statement 
I 

subset  executable  statement 


do_statement : 

RW_DO  optional_integer  IDENTIFIER  •='  expression_list 


optional  integer: 

r*  NULL  */ 

{ 

$$  =  0; 

1 

I 

INTEGER 

( 

$$  =  SI; 

1 


loglcal_i f_statement : 

i f_expression  subset_executable_statement 


i f_expression : 

RW_IF  '('  expression  ')' 


block_if_statement: 

RW_IF  ’<•  expression  ')'  RW_THEN 


else_statement : 

RW  ELSE 


else_i f_statement : 

RW_ELSE_IF  ' ('  expression  ■) '  RW_THEN 


end_i f_statement : 

RW  END  IF 


executable_statement : 
assignment_statement 

assign_3tatement 

arithmetic_i£_statement 

cont inue_statement 

call  statement 


subset 

I 


return  statement 
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uncondi  t  i  onal_go_t  o_st  at  emer.t 

ccmputed_go  to  statement 

assigr.ed_go_to_statement 

stop_statement 

pause_  st atement 

io  statement 


assignment^statemer.t : 

variable  *='  expression 


assign_statemer,t : 

RW  ASSIGN  INTEGER  RW  TO  lOr.NTIr  IFR 


arithmetic  i  f_st atement : 

RW_IF  *  ( •  expression  1 )'  .  nteger  . :s: 


ccntinue_staterr',ent  : 

RW  CONTINUE 


call_stacement : 

RW_CALL  IDENTIFIER 

»W_CALL  IDENTIFIER  opt i cna 1 _act  ua 1 _a rgu.mer.c_i 1st 


optionai_actual_araumenc_i 1st : 
'!•')' 

( 

S$  =  0; 

i 

actual_a  rg 'rrer.t_i  l  st  ■  )’ 

SS  =  S  ^ ; 

i 


actuai_argument_l 1st : 

actual_argurr.ent 

i 

SS  =  merge!  SI  ); 

1 

actual_argumer,t_l  i  sc  ac  jal_argumer.t 

( 

SS  -  merge (  "%s<%s}" ,  SI,  S3  ); 

t 


actual  argument: 

expression 

( 

SS  =  SI; 

1 

actual  argument  alternate  return 
( 

SS  -•  SI; 


actual  _a  rgumen  t  a  1  teroate  ret  .  r  n  : 


J 
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INTEGER 

{ 

$$  =  merge  (  "*%s" ,  $2  ); 

} 


return_statement : 

RW^RETURN  opt ior.al_expressi cn 


uncor.di t iona  v_go_to_statement : 
RW  GO  TO  INTEGER 


computed_go__to_statement : 

RW_G0_T0  '(*  integer_list  1 )'  optional 


assigned_go  to_statement : 

RW_(X)_TO  IDENTIFIER 

RW_JjO_TO  IDENTIFIER  opt ional_comma  1  (' 


optional  comma: 

T-  NULL  */ 


integer_list : 

INTEGER 

{ 

$$  =  merge (  ,  $1  ); 

} 

! 

inter'er^l  i  st  INTEGi 

1 

$$  =  merge  (  "%s{%s},’#  $1,  $3  ); 

} 


paosestat .ement : 

RW_PAL'SE  opt ional_expression 


stop_sta t ement : 

RW^STOP  opt iona l_express ion 

i o_stat ement : 

ope n_s tat ement 

ciose_statement 

i nqu i res t a temen t 

read_st a  t ement 

wr i te^statement 

print_statement 

bark spa ce_ st at ement 

rewind  statement. 

end  file  statement 


open  stater 


comma  expression 


integer_iist  '  )  ' 
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RW  OPEN  '('  control  information  list  ')' 


close_statement : 

RW  CLOSE  ' ('  control  information  list  *) ' 


i nqui re_st atement : 

RW  INQUIRE  *  ('  control  information_iist  ') ’ 


read_statement : 

RW_READ  ' ('  cont roi_in format ion_l i st  optional_io_list 

I 

RW_READ  control 

I 

RW_READ  control  io_list 


write_st atement : 

RW_WRITE  '('  control_information_list  ' )'  optional_io_list 


print_statement : 

RW_PRINT  control 

I 

RW_PRINT  control  io  list 


bac<space_statement : 

RW_BACK SPACE  '('  con t ro±_in format ion_l ist  ')' 

I 

RW  BACKSPACE  control 


rewind_statement : 

RW_REWIND  '('  control_information_list  ')' 

i 

RW  REWIND  control 


endf ile_st atement : 

RW_ENDEILE  cont roi _info rmat ion_l ist  ')' 

I 

RW  ENDFILE  control 


cont rol_in format ion_l ist : 

control  information 

( 

SS  =  merge)  "(%st",  SI  ); 

} 

I 

cont rol_inf ormat i on_l i st  control_information 

( 

SS  ■  merge)  "%s(  %">•",  SI,  S3  ); 

) 


control_i~ formation : 
cont  ro 1 
< 

SS  =  SI; 

) 

I 

IDENTIFIER  '='  control 

f 

SS  =  merge)  "%s  =  %s",  SI,  S3  )  ; 

) 
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control : 

variable 

( 

$$  =  SI; 

) 

I 

constant 

{ 

$$  =  SI; 

1 

I 

•  *  I 

1 

$$  =  duplicate (  ); 

) 


optional  io_list: 

r*  NULL  */ 

1 

SS  =  0; 

) 

I 

io_list 

( 

SS  =  SI; 

} 


io_list : 

io 

{ 

$$  =  merge!  "(%s)",  SI  ); 


io^list  ' , '  io 

{ 

S  $  =  merge!  “  %  s  (  %  s }  " ,  $  1 ,  S3  )  ; 

1 


expression 

( 

SS  =  SI; 

1 

io  implied_do  list 

( 

SS  =  SI; 

1 


io  implied_do_list : 

'('  io_list  IDENTIFIER  expression_l i st  ')' 

1  SS  -  merge!  "(  %s,  is  =  *s  )  list!  $2,  ”,  ”  ), 

} 


$4,  list!  S6,  ”,  " 


) 


format_statement : 

RW  FORMAT 


»» 


FILE:  common/include/list . h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
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*  Author:  Stephen  R.  Wachtel 

*/ 


#define  LIST  struct  list_type 
LIST 
{ 

char  'identifier; 
char  'alternate; 
int  usage; 

LIST  'next; 

}  ; 


extern  LIST 
extern  LIST 
extern  LIST 
extern  void 
extern  LIST 
extern  void 
extern  void 


*end_list (  ) ; 

' add_l i s  t (  )  ; 

* f ind_list {  ) ; 
usage_list(  ); 
*find_index(  ); 
print_list  (  )  ; 
delete  list(  ); 


FILE:  common/library/Makefile 


# 

#  Copyright  1991 

t  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


CC  »  cc  -g 
INCLUDE  =  ../include 
CFLAGS  =  -IS (INCLUDE) 
LIBRARY  =  library. a 


OBJECTS  =  \ 
count. o  \ 
duplicate. o  \ 
hollerith.o  \ 
link_list.o  \ 
list.o  \ 
main.o  \ 
merge.o  \ 
non_blank.o  \ 
parse. o  \ 
replicate. o  \ 
type.o  \ 
uppercase. o  \ 
yyerror.o  \ 
yygetc.o  \ 
yywrap. a 


$ (LIBRARY) : S (OBJECTS) 

ar  crv  S (LIBRARY)  S (OBJECTS) 
rani ib  S (LIBRARY) 


.SUFFIXES:  .c  .o 
.  c .  o : 

S(CC)  -c  S  (CFLAGS)  $< 


clean : 

rm  -f  S (LIBRARY)  5 (OBJECTS) 


FILE:  common/1 ibrary/count .  c 


/' 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
'  Author:  Stephen  R.  Wachtel 

*/ 
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int  count (  string,  length,  c  ) 
register  char  'string; 
register  int  length; 
register  char  c; 

{ 

register  int  c_count  =  0; 

while  (  length  !=  0  ) 

( 

if  (  'string  ==  c  ) 
c_count++; 

string++; 

length — ; 

) 

return (  c  count  ); 

)  /'  count  * r 


FILE:  common/library/dupl icate . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Kachtel 

*/ 


♦include  sstdio.h> 
♦include  <string.h> 
♦include  <malloc.h> 


char  'duplicate (  string  ) 
register  char  'string; 

< 

register  char  'temporary  »  (char  '(NULL; 

if  (  string  !=  (char  ' ) NULL  ) 

( 

if  (  (  temporary  =  (char  *)malloc(  strlen(  string  )  +  1  )  )  !=  (char 

strcpyf  temporary,  string  ); 

else 

fprintf(  stderr,  "ERROR:  duplicate!  %s  )\n",  string  ); 

) 

return)  temporary  ); 

)  /'  duplicate  '/ 


FILE:  common/library/hollerith. c 


/* 

'  Copyright  1991 

'  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

'/ 


♦include  <stdio.h> 


char  'hollerithf  string,  delimeter  ) 
register  char  'string; 
register  char  delimeter; 

( 

int  hollerith_length; 
register  int  string_iength  =  0; 

sscanf(  string,  "%dh",  Shollerith^length  ); 

string)  string_length++  J  =  deiimeter; 
while  (  hoi lerith_length  !=  0  ) 

( 


'(NULL  ) 
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if  (  (  string[  string_length  1  =  yyinput<  >  )  ==  ' \n'  ) 

{ 

yyunput (  string [  st ring_length  1  ); 

break; 

} 

string_length++; 
hollerith_length — ; 

} 

string [  string_length++  J  =  delimeter; 

string!  3i_^iiig_rength  ]  =  '  Non¬ 
return  (  string  ); 

(  /*  hollerith  */ 


FILE:  common/library/link_list .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 
((include  <string.h> 
♦include  <malloc.h> 
♦include  "list.h" 


extern  FILE  *yyin; 
extern  FILE  ‘yyout; 
extern  char  ‘merge (  ) ; 


LIST  »end_list(  list  ) 
register  LIST  ‘list; 

( 

if  (  list  ! =  (LIST  ‘(NULL  ) 

( 

while  (  list~>next  !=  (LIST  ‘(NULL  ) 
list  «  list->next; 

) 

return!  list  ); 

)  /*  end  list  */ 


LIST  *add_list (  list,  common_name,  identifier  ) 
register  LIST  “list; 
register  char  *common_name; 
register  char  ‘identifier; 

( 

register  LIST  ‘temporary  =  (LIST  ‘(mallocf  sizeof(  LIST  )  ); 

if  (  common_name  ==  (char  ‘(NULL  ) 

( 

temporary->identifier  =  identifier; 
temporary->alternate  =  (char  ‘(NULL; 

) 

else 

( 

temporary->identifier  =  identifier; 

temporary->alternate  =  merge (  "%s.%s",  common  name,  identifier  ); 

) 


temporary->usage  =  0; 
temporary->next  =  (LIST  ‘(NULL; 

if  (  ‘list  ==  (LIST  ‘(NULL  ) 
•list  »  temporary; 

else 

end_list(  ‘list  ) ->next  = 

return!  temporary  ); 

)  /*  add  list  */ 
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LIST  "find_list  I  list,  identifier  ) 
register  LIST  "list; 
register  char  "identifier; 
f 

while  (  list  !=  (LIST  "(NULL  ) 

1 

if  (  strcmpf  list->identi fier,  identifier  )  ==  0  ) 
return (  list  )  ; 

list  =  list->next; 

} 

-•l-tirnt  /LIST  *  >  NULL  >; 

}  /*  find  list  */ 


void  usage_list (  list,  identifier  ) 
register  LIST  "list; 
register  char  "identifier; 

< 

register  LIST  "temporary; 

if  (  (  temporary  =  find_list(  list,  identifier  )  )  !=  (LIST  "(NULL  ) 
temporary->usage++; 

)  /*  usage_list  */ 


LIST  *find_index(  list,  index  ) 
register  LIST  "list; 
register  int  index; 

{ 

while  (  list  !=  (LIST  "(NULL  ) 

1 

if  (  — index  ==  0  ) 
return)  list  ); 

list  =  list->next; 


return!  (LIST  "(NULL  ); 
)  /*  find  index  */ 


void  print_list(  list,  name  ) 
register  LIST  "list; 
register  char  "name; 

f 

while  (  list  ! =  (LIST  "(NULL  ) 

{ 

fprintf (  yyout,  "d (\"UU%s ,FOR\", \"%s\", \"%s\” , %d) \n",  name,  list->identifier 
list->alternate,  list->usage  ); 

list  =  list->next; 

1 

1  /*  print_list  */ 


void  delete_list(  list  ) 
register  LIST  "list; 

( 

if  (  list  !=  (LIST  "(NULL  ) 

( 

deiete_list (  list->next  ); 
free (  list  ) ; 

) 

(  /’  delete_list  */ 


FILE:  common/1 ibrary /I i s"  .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 

*/ 


extern  char  "parse (  ); 
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extern  char  *,nerge  (  ); 


char  'list(  input_list,  delimeter  ) 
register  char  *input_list; 
register  char  'delimeter; 

{ 

register  char  *output_list; 
register  char  'list; 
register  char  'temporary; 

outputlist  =  parse (  input_list  ); 
list  =  parse (  input_list  ); 

while  (  list  !=  (char  *)0  ) 
f 

temporary  =  merge!  ”%s%s%s",  output_list,  delimeter,  list  ); 

free(  output_list  ); 

free (  list  ) ; 

output_list  =  temporary; 

list  =  parse (  input_list  ); 

> 

return)  output_list  ); 

}  /*  list  */ 


FILE:  common/library/main.c 


/* 

*  Copyright  1991 

'  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
'  Author:  Stephen  R.  Wachtel 

'/ 


#include  <stdio.h> 


extern  FILE  'yyin; 
extern  FILE  'yyout; 


tdefine  PROGRAM  argument!  0  ] 
♦define  INPUT_FILE  argument!  1  ] 
♦define  OUTPUT_FILE  argument!  2  J 


int  main(  number_argument,  argument  ) 
int  number_argument; 
char  'argument [  ] ; 

( 

if  (  number_argument  ==  1  ) 

! 

yyin  =  stdin; 
yyout  =  stdout; 

yyparse(  ); 
exit  (  0  ) ; 

( 


if  (  number_argument  ==  3  ) 
( 


if 

/ 

(  (  yyin 

=  fopen ( 

INPUT_FILE, 

"r"  )  )  (FILE  ' ) NULL  ) 

\ 

fprintf ( 

stderr. 

"%s :  ERROR  - 

unable  to  open  input  file  '%s'\n", 

.  PROGRAM 

INPUT_FILE 

)  ; 

exit (  -1 

>  ; 

} 


if 

/ 

(  (  yyout  =  fopen ( 

OUTPUT_FI LE,  "w"  )  )  ==  (FILE  *)NULL  ) 

1 

fprintf (  stderr. 

"%s:  ERHOR  -  unable  to  open  output  file  ’%s'\n", 

,  PROGRAM 

0(JTPUT_FILE 

)  ; 

exit  (  -1  )  ; 

) 
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yyparse (  ) ; 
exit <  0  ) ; 

} 

fprintf(  stderr,  "usage:  %s  cinput  £ile>  coutput  file>\n",  PROGRAM  ); 
exit (  0  ) ; 

1  /*  main  */ 


FILE:  common/library/merge . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  <malloc.h> 


♦define  STRLEN (  s  )  (  strlenl  s  )  -  2  ) 


char  "merge (  string,  a,  b,  c,  d  ) 
register  char  "string; 
register  char  *a; 
register  char  *b; 
register  char  *c; 
register  char  *d; 

( 

register  char  "temporary  =  (char  "(NULL; 

switch  (  count (  string,  strlen(  string  ),  '%'  )  ) 

( 

case  0: 

if  (  (  temporary  =  (char  *)malloc(  strlenl  string  )  +  1  )  )  !=  (char  "(NULL  ) 
sprintff  temporary,  string  ); 

else 

fprintfl  stderr,  "ERROR:  merge!  %s  )\n",  string  ); 

break; 

case  1 : 

if  (  (  temporary  =  (char  *)malloc(  strlenl  string  )  +  STRLEN (  a  (  +  1  )  )  != 

(char  * ) NULL  ) 

sprintf(  temporary,  string,  a  ); 

else 

fprintfl  stderr,  "ERROR:  merge!  %s,  %s  )\n",  string,  a  ) ; 

break; 

case  2: 

if  (  (  temporary  =  (char  *)malloc(  strlenf  string  )  +  STRLEN!  a  )  +  STRLEN (  b 
)  +  1  )  )  !=  (char  "(NULL  ) 

sprintfl  temporary,  string,  a,  b  ); 

else 

fprintfl  stderr,  "ERROR:  merge!  %s,  %s,  %s  )\n",  string,  a,  b  ); 

break; 

case  3: 

if  (  (  temporary  »  (char  "(mallocl  strlenl  string  )  +  STRLEN!  a  )  +  STRLEN!  b 
!  +  STRLEN  (  c  )  +  1  )  )  !  =■  (char  "(NULL  ) 

sprintff  temporary,  string,  a,  b,  c  ); 

else 

fprintfl  stderr,  "ERROR:  merge!  %s,  %s,  is,  %s  )\n",  string,  a,  b,  c  ); 

break; 

case  4: 

if  (  (  temporary  =  (char  "(mallocl  strlenl  string  )  +  STRLEN  (  a  )  +■  STRLEN  (  b 
)  +  STRLEN!  c  )  +  STRLEN (  d  )  +  1  )  )  !=  (char  "(NULL  ) 
sprintff  temporary,  string,  a,  b,  c,  d  ); 

else 

fprintfl  stderr,  "ERROR:  merge!  %s,  %s,  %s,  %s,  %s  )\n",  string,  a,  b,  c,  d 

)  ; 

break; 


default : 

fprintfl  stderr,  "ERROR:  merge!  %s  )\n",  string  ); 
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break; 


return)  temporary  ); 
}  /*  merge  '/ 


FILE:  common/library/non_blank.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  technology 

*  Computer  Engineering  Research  Laboratory 
’  Author:  Stephen  R.  Wachtel 

*/ 


((include  <string.h> 


char  *non_blank(  string  ) 
register  char  'string; 

{ 

register  int  offset; 
register  int  length; 


length  =  strlen)  string  )  -  1; 

while  (  (  string!  length  1  ==  •  1  )  it  (  string!  length 
string!  length —  ]  =  '\0‘; 

offset  =  0; 

while  (  (  string!  offset  ]««'')  ss  (  string!  offset 
string!  offset++  ]  =  '\0'; 


strcpy(  string,  sstring!  offset  ]  ); 


if  (  strlen)  string  )  !=  0  ) 

return)  string  ); 

else 

return (  0  ) ; 

)  /*  non  blank  */ 


■\0'  )  ) 

•  \  0  •  )  ) 


FILE:  common/library/parse. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
'•  Author:  Stephen  R.  Wachtel 

*/ 


((include  <string.h> 
extern  char  'duplicate)  ); 


char  'parse)  list  ) 
register  char  'list; 

{ 

register  int  length  =  0; 

register  int  brace  =  0; 

register  char  'temporary  =  (char  *)0; 

for  (;;) 

( 

switch  (  list!  length  ]  ) 

( 

case  1 ) ■ : 

brace++; 

break; 

case  1  )  '  : 

brace--; 

break; 

( 
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if  (  brace  ==  0  ) 
break; 

length++; 

( 

if  (  length  !=  0  ) 

{ 

list[  length  1  «  '\0'; 

temporary  =  duplicate!  list  +  1  ); 

strcpy!  list,  list  +  1  +  length  ); 

) 

else 

( 

if  (  list[  length  ]  =  ’\0'  ) 

{ 

temporary  =  duplicate!  list  ); 
list[  length  1  =  ,\0'; 

) 

) 

return '  temporary  ) ; 

1  /*  parse  */ 


FILE:  common/library/replicate. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <string.h> 
♦include  <malloc.h> 


char  'replicate!  count,  string,  delimeter  ) 
register  int  count; 
register  char  'string; 
register  char  'delimeter; 

1 

register  char  'temporary  ■  (char  *)malloc<  (  count  *  strlen!  string  )  ) 
1  )  *  strlen!  delimeter  )  )  +  1  ); 

if  (  temporary  j -  (char  ')0  ) 

( 

strcpy!  temporary,  string  ); 

while  (  --count  ’.  =  0  ) 

! 

strcat!  temporary,  delimeter  ); 
strcat!  temporary,  string  ); 

) 

) 

return!  temporary  ); 

}  /*  replicate  '/ 


FILE:  common/library /type . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel  ' 

*/ 


extern  char  'merge!  ); 


char  'type!  type_name,  optional_type_length  ) 

register  char  *type_name; 

register  char  'opt ional_type_length; 

{ 


(  (  count 
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if  (  optional_type_length  .' =  0  ) 

return (  merge (  "%s%s",  type_name,  optional_type_length  )  ); 

else 

return!  type_name  ); 

}  /*  type  */ 


FILE:  common/library/uppercase . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


char  ‘uppercase!  string  ) 
register  char  ‘string; 

( 

register  int  index  =  0; 

while  (  string!  index  ]  !=  '\0'  ) 

{ 

string!  index  ]  =  toupper!  string!  index  )  ); 
index++; 

) 

return!  string  ); 

)  /*  uppercase  */ 


FILE:  common/library/yyerror . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 


extern  int  yylineno; 


void  yyerror (  string  ) 
register  char  ‘string; 

{ 

fprintf!  stderr,  "line  %d,  %s\n“,  yylineno,  string  ); 

exit (  -1  ) ; 

}  /*  yyerror  */ 


FILE:  common/library/yygetc. c 


/» 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 
((include  retype. h> 


extern  int  yylineno; 


int  tab!  length  ) 
register  int  length; 
1 


while  (  length--  !=  0  ) 


32  Annual  Report:  Digital  Emulation  Technology  Laboratory  Volume  1,  Part  2 

yyunput (  1  ‘  )  ; 

return (  1  '  ) ; 

\  /*  tab  */ 


i n  t  y yge  t  c (  file  ) 
register  FILE  ’file; 

( 

int  c; 

int  column [  6  ]; 
loop: 

if  (  (  c  =  getc(  file  )  )  ==  '\t‘  ) 
c  =  tab (  6  )  ; 


if  (  c  ! »  ' \n '  ) 
return (  c  ) ; 


if 

(  (  column!  0 
goto  abort  0; 

= 

getc  ( 

file  )  )  !=  ■ 

'  ) 

if 

(  (  column!  1 
goto  abort  1; 

** 

getc  ( 

file  )  )  !=  • 

■  ) 

if 

(  (  column!  2 
goto  abort  2; 

getc  ( 

file  )  )  !=  • 

•  ) 

if 

(  (  column!  3 
goto  abort_3; 

getc  ( 

file  )  )  !=  ' 

1  ) 

if 

(  (  column!  4 
goto  abort  4; 

* 

getc  ( 

file  ))'.=  ' 

•  ) 

if 

(  isspace!  column 

5  ] 

getc!  file  ) 

)  ) 

goto  abort_5; 

yylineno++; 
goto  loop; 

abort_5 : 

if  (  column!  5  1  ==  ' \t  ‘  ) 
tab (  1  ) ; 
else 
{ 

yyunput (  column!  5  1  ); 
if  (  column!  5  1  ==  *\n'  ) 
yylineno++; 

) 

abort_4 : 

if  (  column!  4  J  »=  ' \t'  ) 
tab(  2  ) ; 

else 

l 

yyunput!  column!  4  )  ); 
if  (  column!  4  1  ==  '\n'  ) 
yylineno++; 

) 

abort_3 : 

if  (  column!  3  1  ==  ' \t'  ) 
tab!  3  ) ; 

else 

{ 

yyunput!  column!  3  ]  ); 
if  (  column!  3  1  ==  '\n'  ) 
yylineno++; 

} 


abort_2 : 

if  (  column!  2  1  ==  '\t‘  ) 
tab (  A  ) ; 

else 

{ 

yyunput!  column!  21); 
if  (  column!  2  ]  «»  ‘\n'  ) 
yylineno++; 

) 

abort_l : 

if  (  column!  1  J  ==  '\t'  ) 
tab!  5  ) : 
else 
( 


yyunput!  column!  1  I  ); 
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> 


if  (  column [  1 
yylineno++; 


1  \n ' 


) 


abort_0 : 

if  (  column [  0  ;  ==  1 \t‘  ) 
tab (  6  ) ; 

else 

( 

yyunput (  column!  0  J  ); 
if  (  column!  0  i  ==  ’\n'  ) 
yylineno+t; 

) 


return (  c  ) ; 
I  /’  yygetc  »/ 


FILE:  common/library/yywrap. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*  / 


int  yywrap(  ) 

( 

return (  1  ) ; 
}  /*  yywrap  */ 


FILE:  common/scanner. 1 


%< 

/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


») 

%a 

10000 

%e 

10000 

%k 

10000 

%n 

10000 

%o 

10000 

»p 

1 0000 

a 

[aA] 

b 

(bB] 

c 

[cC] 

d 

[dDi 

e 

teE] 

f 

(fF) 

g 

CgG] 

h 

[hH] 

i 

[11] 

j 

[  jj] 

k 

[JtK] 

1 

[1L] 

m 

[raM] 

n 

[nN] 

0 

[oO] 

P 

(pPi 

q 

fqQl 

r 

[  r  R  ] 

s 

[sS] 

t 

l  tT] 

u 

[uU] 

V 

[W] 

w 

[wW] 

X 

[xX] 

y 

[yY] 
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%( 

^include  "grammar . 0" 
extern  char  “yylval; 


lundef  YYLMAX 
Idefine  YYLMAX  (256*20) 


extern  char  “duplicate!  ) 
extern  char  *hallerith(  ) 
extern  char  *non_blank(  ) 
extern  char  'uppercase!  ) 

%} 


%% 


* [\*cC] .* [\nl  I 
A[\  )*[\n!  | 

Iifdef  DEBUG 
ECHO; 
lendif 

yylval  =  duplicate!  yytext  ); 
return!  COMMENT  ); 

1 


t\  1  { 

lifder  DEBUG 
ECHO; 
lendi f 

/*  return (  ' \  '  )  */; 

1 


(\sl  ( 

I i fde  f  DEBUG 
ECHO; 
lendi f 

return  (  ‘  \S  '  )  ; 

) 


(\  (1  f 
Iifdef  DEBUG 
ECHO; 
lendi f 

return (  • \  ( '  ) ; 

} 


t\)  1  ( 

Iifdef  DEBUG 
ECHO; 
lendi f 

return  (  ’ \ )  '  )  ; 

1 


[\* :  ( 

Iifdef  DEBUG 
ECHO; 
lendi f 

return (  ' \ * ' 

1 


f  \  *  !  [  \  *  1  ! 

Iifdef  DEBUG 
EC- 
lend i  f 

return!  EXPONENTIATE  ); 

j 


[\*1  ( 
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# i fde  f  DEBUG 
ECHO; 
tendi f 

return (  1 \+ 1  ) ; 

i 


E\.  ]  { 

t i fde  f  DEBUG 
ECHO; 
tendi f 

return  (  '  \ ,  *  )  ; 

) 


[\-l  ( 

tifdef  DEBUG 
ECHO; 
tendif 

return  (  ' \- '  ) ; 

} 


(\.)  ( 

#i fdef  DEBUG 
ECHO; 
tendi  f 

return (  ' \ '  ) ; 

) 


[\/]  { 
t i fdef  DEBUG 
ECHO; 

#endi f 

return (  ' \/ '  )  ; 

i 


[\:1  { 

# i fdef  DEBUG 
ECHO; 

#endi  f 

return (  ' \ : '  ) ; 

) 


t\  =  )  ( 

tifdef  DEBUG 
ECHO; 
tendi f 

return  (  ' \= 1  )  ; 

I 


[\n]  ( 

tifdef  DEBUG 
ECHO; 
tendi f 

/*  return)  '\n'  )  */; 

) 


r\t  i  ( 

tifdef  DEBUG 
ECHO; 
tendi f 

/*  return  (  ' \t  '  )  */; 

) 


tifdef  DEBUG 
ECHO; 
tendi  f 

return)  RW_AND  ); 

) 


[\.!(e){q)[\.l  ( 
tifdef  DEBUG 
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ECHO; 
lendi f 

return!  RW_EQ  ); 

) 


[\.  ]  (elfqHv)  [\.l  f 
#i fdef  DEBUG 
ECHO; 
lendif 

return  (  RW_EQV  ) ; 

I 


l\.HfKa)(lHsl(e)  [\.]  ( 

lifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_FALSE  ) ; 

I 


[\.HgHe][\.]  ( 

#ifdef  DEBUG 
ECHO; 

#e ndif 

return!  RW_GE  ); 

} 


!\.l(g)|t)[\.)  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

return!  RW_GT  ); 

) 


[\.Hl)(e)[\.l  ( 

#i fdef  DEBUG 
ECHO; 

#end if 

return  (  RW  LE  ) ; 

( 


[\.  ini  it)  c\.  ]  < 

#ifdef  DEBUG 
ECHO; 

#endif 

return!  RW_LT  ); 

I 


C \ - ) (n){e)  [ \ .  1  f 
Hi fdef  DEBUG 
ECHO; 
lendif 

return!  RW_NE  ); 

I 


[\.)ln|(e){q|fv)[\.]  { 

# i fdef  DEBUG 
ECHO; 
lendi f 

return!  RW_NEQV  ); 

I 


(\.l(n|to|(t)[\.)  ( 

lifdef  DEBUG 
ECHO; 
lendi f 

return!  RW_NOT  ); 

I 


[\.)(ol(r|[\.l  ( 
I i fdef  DEBUG 
ECHO; 
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#endi  f 

return (  RW_OR  ); 

) 


[V-l {t}{r} (u) (el [\.  1  { 

lifdef  DEBUu 
ECHO; 
lendif 

return  (  RW_TRUE  ) ; 

} 


{a} {s} { s } { i } {g} { n >  ( 
lifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_ASSIGN  ); 

> 


(bllaHcHkIlsHpHaHcHe)  ! 
#i fdef  DEBUG 
ECHO; 
lendif 

return (  RW_BACKSPACE  ) ; 

) 


(b)fl)(o)  (c>{lc}[\  ]*|d)(a)(tHa)  ( 

#i fdef  DEBUG 
ECHO; 

#endif 

return (  RW_BLOCK_DATA  ) ; 

} 


(cHal(l)ll)  ( 

#i fdef  DEBUG 
ECHO; 

#endlf 

return  (  RW_CALL  ); 

) 


(cHhHaHrHa)(clitKe}(r|  ( 
lifdef  DEBUG 
ECHO; 

#endi  f 

return (  RW_CHARACTER  ) ; 

1 


(cHlHoMsMe)  ( 
lifdef  DEBUG 
ECHO; 
lend! f 

return  (  RW_CLOSE  ); 

) 


(c) (o) (m) (m) ( o) ( n)  ( 
lifdef  DEBUG 
ECHO; 
lendi f 

return  (  RW_COMMON  ) ; 

) 


(c)(ol(ni|(p)(lHe)(*)  ( 

lifdef  DEBUG 
ECHO; 
lend! f 

return  (  RW_COMPLEX  ); 

) 


(c)lol ( n ) ( t } ( i ) (n) (u) (e)  ( 

lifdef  DEBUG 
ECHO; 
lendi f 
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return  (  RW  CONTINUE  ); 


IdilaHtHa!  ( 
lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_DATA  ) ; 

1 


IdlliUmHeHnllsMiltoKnl  { 
lifdef  DEBUG 
ECHO; 
lendi f 

return (  RW_DIMENSION  ); 

1 


(d)(0)  ( 

#ifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_DO  ) ; 

) 


(d)(o)  (u)  (b)  (1)  (e)  [\  l*(pl(r)(eHcKi)|s)|i)(o)(n)  ( 

lifdef  DEBUG 
ECHO; 
lendif 

return!  RW_DOUBLE_PRECISION  ); 

1 


(e)U)(s)(e)  ( 

#i fdef  DEBUG 
ECHO; 

#endi f 

return (  RW_ELSE  ) ; 

) 


(e){l)(sKe)  [\  IMil(f)  ( 
#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_ELSE_IF  ); 

1 


(e) (n) (d)  ( 

lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_END  ); 

) 


(e) ( n) (d) [\  ]*(i)(f)  ( 

lifdef  DEBUG 
ECHO; 
lendi f 

return  (  RW_END_IF  ) ; 

) 


(e)(n)(d)(f)(i)(l)(e)  ( 

lifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_ENDFILE  ); 

) 


(e)(n){t)(r)(y)  ( 

lifdef  DEBUG 
ECHO; 
lendi f 


return!  RW  ENTRY.  ); 
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) 


(eHqHu}|i|(vKa)|lHe}|n|{c)(e)  ( 
# i fde  f  DEBUG 
ECHO; 

#endi  f 

return (  RW_EQU I VALENCE  ); 

) 


(ellx)ltl(eHrHnl(aHl)  f 
# i fdef  DEBUG 
ECHO; 
lendif 

return (  RW_EXTERNAL  ); 

} 


(f)(oHr)fm){a>{t).»  ( 

i i fde  f  DEBUG 
ECHO; 

#endif 

yylval  =  duplicate (  yytext  ); 
return (  RW_FORMAT  ); 

) 


(£)|u)|nKc)(t)liHoHn)  { 
#ifdef  DEBUG 
ECHO; 
iendif 

return (  RW_FUNCTION  ); 

) 


<gHo)  (\  IMtl(o)  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_GO_TO  ); 

) 


(i)(f)  ( 

#ifdef  DEBUG 
ECHO; 
ftendif 

return (  RW_IF  ); 

1 


(iHm)(pMl)(i|(clii|(t)  { 
#ifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_IMPLICIT  ); 

) 


(i)  { n  }  (c)llHul  (d)  {e>  ( 

(tifdef  DEBUG 
ECHO; 

(tendi  f 

return  (  RW_INCLUDE  ) ; 

) 


(  i  Mn)  (q)  (ul  |  i  )  (  r)  (e)  ( 

It  i  fdef  DEBUG 
ECHO; 
llendi  f 

return!  RW_INQUIRE  ); 

} 


(i)(n)(t){el{g){e}(r)  ( 

#i fdef  DEBUG 
ECHO; 

Itendi  f 

return!  RW  INTEGER  ); 
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1 


(iHnlltl(r|(il(n)|s)|iHc)  ( 
#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_INTRINSIC  ); 

) 


(lMoMgHiHcHaKl)  { 
#ifdef  DEBUG 
ECHO; 
aendif 

return (  RW_LOGICAL  ) ; 

} 


InHaHmHeHlHiHsKt)  { 
fifdef  DEBUG 
ECHO; 

#endif 

return (  RW_NAMELIST  )  ; 

} 


(oKpHellnl  { 
iifdef  DEBUG 
ECHO; 

#endif 

return (  RW_0PEN  ) ; 

) 


(pHaHr|(a}(m)(el(t)(«Mr!  { 
#ifdef  DEBUG 
ECHO; 
lendif 

return  (  RW  PARAMETER  ); 

) 


IpHaHuHaHe)  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  RWPAUSE  ) ; 

) 


(pHr)ID(nKt)  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_PRINT  ); 

) 


(Pi  (  r )  (oKqK  rHaHm)  ( 
#i£def  DEBUG 
ECHO; 

♦endif 

return (  RW_PROGRAM  ); 

) 


(rl(eHaHd)  { 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_READ  ) ; 

) 


(rlleKaHl)  { 

#ifdef  DEBUG 
ECHO; 

(tendif 

return!  RW_REAL  ); 

) 
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(r)(e)lt)(u)(r)(n)  { 
lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_RETURN  ); 

1 


IrlleHwKlMnHdl  { 

#ifdef  DEBUG 
ECHO; 

#endif 

return)  RW_REWIND  ); 

1 


(sHaHvHe)  { 
lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_SAVE  ) ; 

1 


(s)(t){o}(p)  { 

lifdef  DEBUG 
ECHO; 
lendi f 

return (  RW_STOP  ) ; 

1 


(JlluHbKrKoHuKtHillnHel  ( 

lifdef  DEBUG 
ECHO; 
lendi f 

return)  RW_SUBROUTINE  ); 

1 


(t)(h)(e)(n)  { 

lifdef  DEBUG 
ECHO; 
lendif 

return)  RW_THEN  ); 

) 


(t>(o)  { 

lifdef  DEBUG 
ECHO; 
lendif 

return)  RW_TO  ); 

1 


)w|(r)(iMt)(e}  ( 

lifdef  DEBUG 
ECHO; 
lendi f 

return (  RW_WRITE  ) ; 

) 


(uHnHdHeHfHiHnHeHd)  ) 
lifdef  DEBUG 
ECHO; 
lendi f 

return)  RW_UNDEFINED  ); 

) 


[a-zA-ZJ  [_a-zA-Z0-9J  *  ( 

lifdef  DEBUG 
ECHO; 
lendi  f 

yylval  =  duplicate)  uppercase)  yytext  )  ); 
return)  IDENTIFIER  ); 

) 
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"[0-9  1 [0-9  ] [0-9  1 [0-9  1 [0-9  1 [\  1  { 

tifdef  DEBUG 
ECHO; 
tendif 

yylval  =  duplicate!  non_blank (  yytext  )  ); 
return (  LABEL  ) ; 


[0-91+  I 

[0-91  +  /\ . [a-zA-Zl +\ .  ( 

tifdef  DEBUG 
ECHO; 
tendif 

yylval  =  duplicate (  yytext  ); 
return (  INTEGER  ) ; 


[0-91 +\.  [0-9]  *([eE]  (\  +  \-l  ?[0-9)+)  ?  | 

[0-91 [0-9]+<[eE] [\+\-l ?[0-9]+) ?  I 
(0-91  +  ( (eEl  [\+\-l? [0-91+1?  { 
tifdef  DEBUG 
ECHO; 
tendif 

yylval  -  duplicate)  yytext  ); 
return (  REAL  ); 

1 


[0-91 +\.  [0-9]  *  ( [dD]  [\  +  \-l  ?[0-9)+)  ?  | 

[ 0-9] *\ . [0-9]  +  ([dD]  [\+\-l ? [0-9] +) ?  | 

[0-9]  +  ( [dD]  [ \+\-l ? [0-9] +) ?  ( 
tifdef  DEBUG 
ECHO; 
tendif 

yylval  =-  duplicate!  yytext  ); 
return (  DOUBLE_PRECISION  ); 

1 


\ ■ [~\ • ] *\ '  I 

\"r\"]*\"  ( 

tifdef  DEBUG 
ECHO; 
tendif 

yytext [  0  1  =  1 \"'; 

yytext  [  strlenf  yytext  )  -  1  ]  =  ' \’"; 
yylval  =  duplicate!  yytext  ); 
return!  STRING  ); 

1 


[0-9] + [hH]  ( 
tifdef  DEBUG 
ECHO; 
tendif 

yylval  =  duplicate!  hollerith!  yytext,  ' '  )  ); 
return!  HOLLERITH  ); 
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10.  Appendix  E:  ctimer  program  source 

FILE:  ctimer/Makefile 


# 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


default:  ctimer 


CC  =  cc  -g 
INCLUDE  -  include 
CFLAGS  -  -1$ (INCLUDE) 

LIBRARY  =  statement/ statement . a  library/library. a 


OBJECTS  -  \ 

S (INCLUDE) /grammar. h  \ 
•grammar. [co]  \ 
.•scanner. [co]  \ 
yy trace. [co]  \ 
y . output 


PROGRAMS  =  \ 
•ctimer 


grammar. c:  grammar. y 
yacc  -dv  grammar. y 
mv  y.tab.h  $ (INCLUDE) /grammar .h 
mv  y.tab.c  grammar .c 


scanner. c:  scanner. 1 

lex  -vt  scanner. 1  I  sed  * s/getc/yygetc/ '  >scanner.c 


scanner. o:  scanner. c  $ (INCLUDE) /grammar. h 
S (CC)  S (CFLAGS)  -c  scanner. c 

grammar. o:  grammar. c 

$(CC)  $  (CFLAGS)  -c  grammar,  c 

ctimer:  grammar. o  scanner. o  $ (LIBRARY) 

S (CC)  -o  ctimer  grammar. o  scanner. o  S (LIBRARY) 


sgrammar .c: grammar . c  yytoken.awk 

awk  -f  yytoken.awk  <grammar.c  >sgrammar.c 

sgrammar. o: sgrammar. c 

S (CC)  $ (CFLAGS)  -c  sgrammar. c 

sctimer:  sgrammar. o  scanner. o  $ (LIBRARY) 

S (CC)  -o  sctimer  sgrammar. o  scanner. o  S (LIBRARY) 


dscanner.c:  scanner. c 

cp  scanner. c  dscanner.c 

dscanner.o: dscanner.c  S (INCLUDE) /grammar. h 
$<CC)  S (CFLAGS)  -DDEBUG  -c  dscanner.c 

detimer:  grammar.o  dscanner.o  S (LIBRARY) 

$ (CC)  -o  detimer  grammar.o  dscanner.o  S (LIBRARY) 


tgrammar.c: grammar. c 

sed  '  s/yystacn. : /S  yytrace  (yystate)  ;  /  '  <grammar.c  >tgrammar.c 


tgrammar.o:  tgrammar.c 

S  (CC)  S (CFLAGS)  -c  tgrammar.c 
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tctimer:  tgrammar.o  scanner. o  yytrace.o  $ (LIBRARY) 

$ (CC)  -o  tctimer  tgrammar.o  scanner. o  yytrace.o  $ (LIBRARY) 


yytrace.c:  grammar. c  yytrace.awk 

awk  -f  yytrace.awk  <y. output  >yytrace.c 

yytrace.o:  yytrace.c 

$(CC)  $(CFLAGS)  -c  yytrace.c 


clean: 

cd  statement;  make  clean 
cd  library;  make  clean 
rm  -f  S (PROGRAMS)  $ (OBJECTS) 


FILE:  ctimer/grammar . y 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


/* 

*  FORTRAN  77 

*/ 


%token  RW_AND 
*token  RW_ASSIGN 
%token  RW_BACKSPACE 
%token  RWBLOCKDATA 
%token  RW_CALL 
%token  RW_CHARACTER 
»token  RW_CLOSE 
♦token  RW_COMMON 
*token  RW_COMPLEX 
%token  RW_CONTINUE 
%token  RW_DATA 
*token  RW_DIMENSION 
%token  RW_DO 

»token  RW_DOUBLE_PRECISION 

%token  RW_ELSE 

♦token  RW_ELSE_IF 

♦token  RW_END 

%token  RW_END_IF 

%token  RW_ENDFILE 

%token  RW_ENTRY 

%token  RW_EQ 

%token  RW_EQUI VALENCE 

%token  RW_EQV 

»token  RW_EXTERNAL 

%token  RW_FALSE 

♦token  RW_FORMAT 

♦token  RW_FUNCTION 

♦token  RW_GE 

♦token  RW_GO_TO 

♦token  RW_GT 

♦token  RW_IF 

♦token  RW_IMPLICIT 

♦token  RW_INCLUPE 

♦token  RW_INQUIRE 

♦token  RW_INTEGER 

♦token  RW_INTRINSIC 

♦token  RW_LE 

♦token  RW_LOGICAL 

♦token  RW_LT 

♦token  RW_NAMELIST 

♦token  RW_NE 

♦token  RW_NEQV 

♦token  RW_NOT 

♦token  RW_OPEN 

♦token  RW_OR 

♦token  RW_PARAMETER 

♦token  RW_PAUSE 

♦token  RW  PRINT 
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%to)cen  RW_PROGRAM 
♦token  RW_READ 
♦token  RW_REAL 
♦token  RW_RETURN 
%tOKen  RW_REWIND 
♦ token  RW_SAVE 
%to)cen  RW_STOP 
♦token  RW_SUBROUTINE 
♦token  RW_THEN 
%token  RW_TO 
%token  RW_TRUE 
♦token  RW_WRITE 
♦token  RW  UNDEFINED 


♦token  COMMENT 
♦token  CONCATENATE 
♦token  DOUBLE_PR£CISION 
♦token  EXPONENTIATE 
♦token  HOLLERITH 
♦token  IDENTIFIER 
♦token  INTEGER 
♦token  LABEL 
♦token  REAL 
♦token  STRING 


♦  left  • 

♦nonassoc  '  :  ' 

♦  right 

♦left  RW_EQV  RW_NEQV 
♦left  RWJ3R 
♦left  RW_AND 
♦left  RW_NOT 

♦nonassoc  RW_EQ  RW_NE  RW_LT  RW_LE  RW_GT  RW_GE 
♦left  CONCATENATE 
♦left  ■+■ 

♦left  •*'  '/' 

♦right  EXPONENTIATE 
♦left  SIGN 


♦  { 

typedef  char  ‘POINTER; 
#def ine  YYSTYPE  POINTER 


extern  POINTER 
extern  POINTER 
extern  POINTER 
extern  POINTER 
extern  POINTER 
extern  POINTER 
♦  1 


array  (  ); 
duplicate  (  ); 
implied_do_list ( 
label (  ) ; 
merge (  ) ; 
type (  ) ; 


)  ; 


♦  ♦ 


program: 

optional_statement_list 

( 

summary (  )  ; 

} 


optional  statement_list : 
r*  NULL  */ 

I 

statement  list 


statement_list : 

statement 

I 

statement  list  statement 


statement : 
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comment_statement 

label  unlabeled_statement 

{ 

statement (  $1  )  ; 

1 


comment_statement : 

COMMENT 

{ 

if  (  timer(  SI  )  ==  0  ) 

( 

comment_statement (  $1  ) ; 

} 

1 


label : 

LABEL 

( 

$$  -  label (  $1  ) ; 

1 


unlabeled_statement : 

include_statement 

I 

program_statement 

I 

block_data_statement 

I 

function_statement 

I 

subrout ine_statement 
I 

entry_statement 

I 

end_statement 

spec! f ication_statement 

executable_statement 

I 

format  statement 


include_statement : 

RW_INCLUDE  character_constant 
( 

include_statement (  $2  >; 

1 


program_statement : 

RW  PROGRAM  program_ident i f ier 

( 

program_statement (  $2  ) ; 

) 


program_identi fier: 

IDENTIFIER 

( 

block (  SI  ); 
SS  =  SI; 

) 


block_data_statement : 

RW  BLOCK_DATA  block_data_ident i f ier 
( 

block_data_statement (  $2  ) ; 

> 
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block_data_iden_ifier: 

IDENTIFIER 

( 

block  (  SI  ) ; 
$$  =  $1; 


function_statement : 

RW_FUNCTION  f unct ion_ident i f ier  optional_formal_ar -  jmerr  _list 

{ 

function_statement (  0,  $2,  $3  ); 

1 

type  RW_FUNCTION  function_identi f ier  opt i onal_f ormal_argument_l i st 

{ 

function_statement (  SI,  $3,  S4  ); 

) 


function_identifier : 
IDENTIFIER 
1 

block  (  SI  ) ; 
SS  =  $1; 

I 


subroutine_statement : 

RW_SUBROUTINE  subrout ine_ident if ier 

( 

subroutine_statement (  S2,  0  ) ; 

) 

I 

RW_SUBROUTINE  subrout ine__ident i fie r  optiopal_formal_argument_list 

{ 

subroutine_statement (  S2,  S3  ); 

) 


subrout ine_identi f ier : 
IDENTIFIER 
( 

block (  SI  >; 
SS  =  SI; 


entry_statement : 

RW_ENTRY  entry_identi£ier 

( 

entry_statement  (  S2,  0  ) ; 

) 

I 

RW_ENTRY  entry_identif ier  optional_form«i_argument_i.ist 
i 

entry_statement (  S2,  S3  ); 

) 


entry_identifier: 

IDENTIFIER 

{ 

SS  >  SI; 

) 


opt iona l_formal_a  rgument_l i s t : 
•  ( ’  ' )  ' 

{ 

S  $  =  0 ; 
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1 


formal_argument_list : 

f ormal_argument 

( 

$$  =  merge!  n{%s)“,  $1  ); 

) 

f ormal_argument_’ ist  formal_argument 

{ 

SS  =  merge!  "%s{%s}“,  SI,  S3  ); 

1 


formal_argument : 

IDENTIFIER 

( 

$$  =  SI; 

} 

I 

f  ormal_^argument_alternate_return 

1 

SS  =  SI; 

1 


formal_argument_alternate_return : 


SS  =  duplicate!  ); 

1 


end  statement: 

RW_END 

( 

end_statement  !  ) ; 

) 


speci f ication_statement : 

external_statement 

I 

intrinsic_statement 

I 

parameter_statement 

I 

dimens ion_statement 

I 

declarat ion_statement 
I 

3ave_statement 

I 

common_st atement 
I 

equi valence_statement 
I 

implicit_statement 

I 

da1-  r_statement 

I 

namelist  statement 


ex ternal_st atement : 

RW_EXTLRNAL  exf:rnal_Lst 

( 

external_statement (  S2  ) ; 

1 
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external_l ist : 

external 

( 

SS  =  merge!  (%s(",  $1  ); 

) 

I 

external_list  external 

{ 

SS  =  merge!  ”%s(%s}",  $1,  S3  ); 

} 


external : 

IDENTIFIER 

{ 

$$  =  SI; 

) 


statement : 

INTRINSIC  intrinsic_list 
intrinsic_statement (  S2  ); 


intrinsic_list: 

intrinsic 

{ 

SS  =  merge (  -f  %s) ",  SI  ) ; 

1 

I 

intrinsic_list  intrinsic 

i 

SS  =  merge!  "%s(%s}"(  SI,  $3  ) ; 

> 


intrinsic: 

IDENTIFIER 

( 

SS  =  $1; 

1 


parameter_statement : 

RW_PARAMETER  '('  parameter_list  ')' 

( 

parameter_statement (  S3  ); 

) 


parameter_l ist: 

parameter 

{ 

SS  =  merge (  " ( %s} ",  SI  ) ; 

) 

I 

parameter_list  parameter 

{ 

SS  =  merge!  "%s(%s}",  SI,  S3  ); 

} 


parameter: 

IDENTIFIER  expression 

( 

SS  =  merge!  ’•  {  %  s  )  {  %  s  >  " ,  SI,  $3  !  ; 

1 


intnnsic_ 

RW_ 

{ 

) 
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dimension_sta Cement : 

RW_DIMENSION  dimension_list 

( 

dimension_statement (  $2  ); 

) 


dimension_list : 

dimension 

{ 

$$  =  merge!  " { % s ) " ,  $1  ); 

) 

I 

dimension_list  dimension 

{ 

SS  =  merge!  "%s(%s}",  SI,  $3  ); 

1 


dimension: 

IDENTIFIER  • ( • subscript_list  •)' 

i 

$$  =  merge!  ”{%s}{%s}",  SI,  S3  ); 

i 


subscript_list : 

subscript 

{ 

SS  »  merge!  “(%s)n,  SI  ); 

1 

I 

subscript_Xist  subscript 

( 

SS  -  merge!  "%s{%s)",  SI,  S3  ); 

) 


subscript : 

uppe r_bound 

( 

SS  =  SI; 

) 

I 

lower_bound  ' : '  upper_bound 

I 

$ S  =  merge!  ” % s : % s " ,  SI,  S3  ) ; 

I 


lower_bound: 

expression 

( 

SS  =  SI; 

) 


upper_bound: 

lower  bound 

! 

SS  -  SI; 

) 

I 

upper_bound_ad just able 
i 

SS  -  SI; 

) 


uppe r_bound_ad just able : 


SS  =  duplicate ( 
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} 


declaration_statement : 

type  declaration_list 

{ 

declaration_statement (  SI,  $2  ); 

) 


declaration_li st : 

declaration 

{ 

$$  =  merge (  ”(%s)“,  $1  ) ; 

) 

I 

declaration_list  declaration 

( 

$$  =  merge (  "%s{%s}'\  $1,  $3  ); 

> 


declaration: 

IDENTIFIER 

{ 

$$  =  merge ( 

1 

I 

IDENTIFIER  ■(' 

( 

$$  =  merge ( 

} 


$1  ): 

subscript_l ist  ' 
"(%sH%s}“,  $1, 


)  ' 

$3  )  ; 


type: 

type_name  optional_type_length 

{ 

$$  =  type (  $1,  $2  ) ; 

1 


type_name : 

RW_CHARACTER 

( 

$$  =  duplicate (  "CHARACTER"  ); 

( 

I 

RW_COMPLEX 

( 

SS  =  duplicate (  "COMPLEX"  ); 

I 

RW_D0U3LE_PRECISI0N 

( 

SS  =  duplicate (  "DOUBLE  PRECISION"  ); 

> 

I 

RW_INTEGER 

( 

SS  =  duplicate (  "INTEGER"  ); 

) 

I 

RW_LOGICAL 

( 

SS  =  duplicate (  "LOGICAL"  ); 

) 

I 

PW_REAL 

{ 

SS  -  duplicate!  "REAL"  ); 
i 
I 

RW_UNDEFINED 

( 

SS  =  duplicate!  "UNDEFINED"  ); 

1 
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optional  type_length: 
r*  NULL  */ 

{ 

SS  =  0; 

1 

I 

type  length 
t 

$5  =  $1; 

) 


type_length: 

INTEGER 

{ 

$$  =  merge  (  $2  ); 

1 

I 

1  *  1  type_length_ad justable 

( 

SS  =  merge (  "*%s”,  $2  ); 

) 


type_length_ad justable: 

.  ...  •)  . 

( 

$$  =  duplicate)  "(*)”  ); 

} 


save_statement : 

RW_SAVE  optional_save_list 

< 

save  statement (  $2  ) ; 

) 


optional  save_list: 
r*  NULL  */ 

I 

$$  =  0; 

) 

I 

save_list 

f 

SS  =  51; 

1 


save^list : 

save 

( 

SS  -  merge (  "( »s) ",  SI  ) ; 

) 

save_list  save 

{ 

SS  *  merge)  "%s{%s>",  $1, 

( 


IDENTIFIER 

{ 

SS  =  SI; 

) 

common_name 

( 

SS  =  SI; 

( 


save : 


I 


S3  )  ; 
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cominon_5tatement ; 

RW_COMMON  opt ional__common_name  comn\on_list 

{ 

common_statement (  $2,  $3  ); 

} 


optional  common_name: 
/*  NULL  */ 

{ 

SS  -  0; 

} 

I 

common_name 

{ 

$?  =  SI; 

) 


common_name : 

■/■  optional_identifier  '/' 

( 

SS  =  $2; 

) 


.[..ional  identifier: 
T*  NULL  */ 

( 

$$  =  0; 

) 

I 

IDENTIFIER 

{ 

SS  -  SI; 

} 


common_list : 

common 

1 

$$  =  merge ( 

) 

I 

common_list  ' , ' 

{ 

SS  =  merge! 

1 


common : 

IDENTIFIER 

( 

SS  =  merge!  "(%sr,  $1  )  ; 

) 

I 

IDENTIFIER  ' (’  subscript_list  •)' 

( 

SS  =  merge!  ,'(%s)(%s)”,  SI,  S3  ); 

) 


SI  )  ; 

common 

"%s{%s}'\  SI,  S3  )  ; 


equivalence_statement : 

RW_EQU I VALENCE  equi valence_l i st 

( 

equivalence_statement  !  S2  ) ; 

) 


equi va lence_l i st : 

equivalence 
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1 

$$  =  merge  (  si  )  ; 

1 


equivalence_list  equivalence 

{ 

$S  =  merge (  "%s(%s}",  SI,  S3  ); 

1 


equivalence : 

'('  variable_list  ') 

( 

$$  =  $2; 

1 


variable_list : 

variable 

{ 

S$  -  merge!  »{%s}",  SI  )  ; 

1 

I 

variable_list  variable 
f 

SS  «  merge!  "%s{%s}“,  51,  S3  ); 

1 


implicit_statement : 

RW_IMPLICIT  type  '('  implicit_list  ')' 

! 

implicit_statement (  S2,  $4  ) ; 

1 


implicit_list: 

implicit 

{ 

SS  *  merge!  SI  )  ; 

1 

I 

implicit_list  implicit 

t 

SS  -  "%s(%s)\  $1,  S3  )  ; 

1 


implicit : 

IDENTIFIER 

( 

SS  =  SI; 


IDENTIFIER  IDENTIFIER 

( 

SS  *  merge!  "%s-%s'\  $1.  $3  ); 

1 


namel ist_statement : 

RW_NAMELIST  namelist_name  namel i st_l i st 
( 

namelist_statement (  S2,  S3  ) ; 

1 


namelist_name: 

’/'  IDENTIFIER  •/' 

{ 

SS  =  S2; 

1 
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namelist_list: 

namelist 

( 

$$  =  merge (  "(%s)",  $1  ); 

) 

I 

namelist_list  namelist 

( 

SS  =  merge  (  “%s{%s},,(  $1,  $3  ); 

} 


namelist : 

IDENTIFIER 

1 

SS  =  51; 

} 


data_statement : 

RW_DATA  data_list 

{ 

data_statement (  S2  )  ; 

} 


data_list : 

data 

( 

SS  =  merge (  "{%s)n,  SI  ); 

) 

I 

data_list  optional_comma  data 

{ 

SS  =  merge  (  "%s{»s),\  $1,  S3  ); 

) 


data : 

data  variable  list  '/'  data  constant  list  '/' 

{ 

SS  =  merge  (  ■■  { %s  >  ( %s }  ",  $1,  S3  ); 

) 


data_variable_l ist : 

data_variable 

{ 

SS  =  merge (  SI  ); 

! 

I 

data_variable_list  data  variable 

{ 

SS  =  merge (  "%sl%s)“.  Si,  S3  ) ; 

( 


data_variable : 

variable 

{ 

SS  =  SI; 

1 

I 

data_implied_do_list 

( 

SS  =  SI; 

) 


data_implied_do_list : 

'('  data_variable_list  IDENTIFIER  •='  expression  list  ')' 

( 
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1 


data_constant_list : 

data_constant 

( 

$$  =  merge  (  $1  ); 

) 

I 

data_constant_list  1 ,'  data_constant 

{ 

S$  =  merge)  "%s{%sj",  $1,  S3  ); 

) 


data_constant : 

data_initialization 

l 

$$  =  SI; 

} 

I 

IDENTIFIER  •*’  data_initialization 

( 

$$  =  merge)  "%s  *  *s",  SI,  S3  )  ; 

) 

I 

INTEGER  data_initialization 

( 

SS  =-  merge)  "%s  *  %s",  SI,  S3  )  ; 

) 


data_initialization: 

IDENTIFIER 

{ 

SS  =  $1; 

) 

I 

character  constant 

( 

SS  -  SI; 

1 

I 

logical  constant 

( 

SS  =  SI; 

) 

I 

signed_numerical_constant 

( 

SS  -  $1; 
i 


signed_numerical_constant : 

numerical_constant 

( 

SS  =  SI; 

) 

1 

'+'  numerical  constant  %prec  SIGN 
( 

SS  =  merge)  "  +  %s’\  S2  ); 

) 

I 

num<  -ical_constant  %prec  SIGN 

( 

SS  =  merge)  "-%s",  S2  ); 

i 


expression : 

pa rent he si s_expressi on 

( 

SS  -  SI; 

> 
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simple_expression 

{ 

$$  =  SI; 

} 


parenthesis_expression: 

' ( '  expression  1 ) 1 

( 

$$  =  merge!  ”  (%s)  ",  $2  )  ; 

1 


simple_expression : 
variable 
( 

$$  =  SI; 

1 

I 

constant 

{ 

$$  =  $1; 

) 

I 

arithmetic_expression 

! 

SS  =  SI; 

1 

I 

character_expression 

( 

SS  -  SI; 

1 

I 

relational_expression 

( 

SS  =  SI; 

) 

I 

logical_expression 

f 

SS  =  $1; 

1 

I 

unary_expression 

( 

SS  =  SI; 

) 


variable : 

IDENTIFIER 

( 

SS  -  SI; 

} 

I 

IDENTIFIER  string_subset 

( 

SS  -  merge!  ”%s  %s",  SI,  S2  ); 

^  1 

array 

( 

SS  =  SI; 

) 


array ; 

IDENTIFIER  '('  opt ional_expression_l i st  ')' 

( 

SS  =  array  (  $1 ,  $3  ) ; 

) 

I 

IDENTIFIER  '('  opt ional_expression_l i st  ')'  string_subset 

( 

SS  =  merge!  "%s  %s",  array!  SI,  $3  ) ,  S5  ) ; 
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1 


optional  expression_list : 
r*  NULL  */ 

( 

$$  *  0; 

> 

I 

expression_list 

( 

SS  =  $1; 

) 


expression_list : 

expression 

{ 

$S  =  merge (  ”{%s}“,  $1  ) ; 

} 

I 

expression_list  1  expression 

{ 

SS  =  merge (  "*s{%s)“(  SI,  S3  ); 

) 


string_subset : 

■('  optional_expression  1 : 1  optional_expression  ')' 

{ 

SS  =  me rge (  "(%s:%s)H,  $2,  $4  ); 

1 


optional  expression: 
r*  NULL  */ 

{ 

SS  =  0; 

1 

I 

expression 

( 

SS  -  SI; 

1 


constant : 

character_constant 

< 

SS  «  SI; 

> 

I 

logical_constant 

( 

SS  =  SI; 


numerical_constant 

( 

SS  -  $1; 

) 


character_constant : 
HOLLERITH 
( 

SS  *  SI; 

> 

I 

STRING 

f 

SS  =  SI; 

1 
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logicai_constant : 

RW_FALS£ 

f 

$$  =  duplicate!  ".FALSE."  ); 

} 

I 

RW_TRUE 

( 

SS  =  duplicate!  ".TRUE."  ); 

) 


numerical_constant : 

DOUBLE  PRECISION 

( 

SS  =  Si; 

> 

I 

INTEGER 

f 

$$  =  $1; 

) 

i 

REAL 

( 

SS  =  $1; 

1 


arithmetic_expression: 

expression  '+'  expression  %prec  '+' 

{ 

SS  =  merge!  "%s  +  %s",  51,  $3  ); 

} 

I 

expression  expression  %prec 

( 

SS  =  merge!  "»s  -  %s",  51,  S3  ); 

) 

I 

expression  expression  %prec 

( 

SS  =  merge!  "%s*%s",  SI,  S3  ) ; 

) 

I 

expression  '/'  expression  %prec  '/' 

{ 

SS  =f  merge!  "%s/%s",  $1,  $3  )  ; 

l 

I 

expression  EXPONENTIATE  expression  %prec  EXPONENTIATE 

( 

SS  =  merge!  "%s**%s",  SI,  S3  ); 

} 


character_expression : 

expression  '/'  expression  %prec  CONCATENATE 

( 

SS  =  merge!  "%s  //  %s",  SI,  $ 4  ); 


relational_expression: 

expression  RW_EQ  expression  %prec  RW_EQ 
f 

SS  =  merge!  "%s  .EQ.  %s",  SI,  S3  ); 

) 

I 

expression  RW_NE  expression  %prec  RW_NE 

( 

SS  =  merge!  "%s  .NE.  %s",  SI,  S3  ); 

) 

I 

expression  RW_LT  expression  %prec  RW_LT 

( 
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$$  =  merge {  ”%s  .LT.  %s",  SI,  S3  ); 

1 

I 

expression  RW_L£  expression  %prec  RW_LE 

{ 

$S  =  merge (  "%s  .LE.  %s",  SI,  $3  ) ; 

) 

I 

expression  RW_GT  expression  %prec  RW_GT 

{ 

SS  -  merge!  "%s  .GT.  Is",  SI,  S3  ) ; 

} 

I 

expression  RW_GE  expression  %prec  RW_GE 

( 

$$  »  merge!  "%s  .GE.  %s",  SI,  S3  ) ; 

} 


logical_expression: 

expression  RW_AND  expression  %prec  RW_AND 

{ 

SS  -  merge!  "%s  .AND.  %s",  SI,  S3  ); 

} 

I 

expression  RW_OR  expression  %prec  RW_OR 

{ 

$S  -  merge!  •■».',  .OR.  %s”,  $1,  $3  >; 

) 

I 

expression  RW_EQV  expression  %prec  RW_EQV 

{ 

SS  =  merge!  "%s  . EQV.  %s",  SI,  S3  ); 

) 

I 

expression  RW_NEQV  expression  %prec  RW_NEQV 

f 

SS  -  merge!  ”%s  . NEQV.  %s",  $1,  S3  ) ; 

I 


unary_expression: 

1 +’  expression  tprec  SIGN 

I 

SS  -  merge!  "  +  %s",  S2  )  ; 

1 

I 

1 -•  expression  %prec  SIGN 
( 

SS  -  merge!  "-%s”,  $2  ); 

) 

I 

RW_NOT  expression  %prec  RW_NO T 

( 

SS  -  merge!  ".NOT.  %s",  $2  ); 
I 


executable_statement : 
do_statement 

I 

logical_i f_statement 
I 

block_i f _statement 
I 

else_statement 

I 

else_if_statement 

i 

end_i f_statement 

I 

subset  executable  statement 


do_statement : 

RW_DO  INTEGER  IDENTIFIER  expression_Ii st 

( 
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do_statement (  $2,  $3,  $5  ); 

1 


logical_if_statement : 

if_expression  subset_executable 

( 

logical_if_statement (  ); 

) 


if_expression: 

RW_IF  '('  expression  1 )' 

( 

i f_expression (  S3  ); 

1 


block_if_statement : 

RW_IF  1 ( 1  expression  ■ ) 1  RW_THEN 

1 

block_if_statement (  S3  ) ; 

) 


else_statemenC : 

RW_ELSE 

( 

else_statement (  ) ; 

) 


else  if_statement : 

RW_£LSE_IF  '('  expression  ')'  RW 

( 

else  i f_statement (  S3  ); 

1 


end_i f_statement : 

RW_END_IF 

( 

end_i f_statement (  ); 

1 


executable_statement : 
assignment_statement 

a3sign_statement 

arithmet ic_i f_statement 

cont inue_statement 

call_statement 

return_statement 

uncondit ional_go_to_statement 

computed_go_to_s’'  atement 

assigned_go_to_st atement 

stop_statement 

pause_statement 

io  statement 


assignment_statement : 


subset 


I 


I 


statement 


THEN 
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variable  '='  expression 
1 

assignment_statement (  $1,  S3  ); 

) 


assign_statement : 

RW_ASSIGN  INTEGER  RW_TO  IDENTIFIER 

{ 

assign_statement (  $2,  $4  ); 

} 


ar i thmet ic_i f _statement : 

RW_IF  ' ('  expression  ') •  integer_list 
f 

arithmetic_if_statement (  $3,  $5  ); 

1 


c-nt inue_statement : 

RW_CONTINUE 

( 

continue  statement (  ) ; 

1 


cal l_statement : 

RW_CALL  IDENTIFIER 
1 

call_statement (  $2,  0  ); 

1 

I 

RW_CALL  IDENTIFIER  opt ional_actual_argument_l i st 

1 

call  statement (  $2,  S3  ); 

( 


optional_actual  argument_l ist : 
r(  ‘  • )  ’  ~ 

{ 

SS  =  0; 

> 

i 

'('  actual_argument_list  ’)' 

( 

SS  =  S2 ; 

1 


actual_argument_list : 

actual_argument 

( 

S $  =  me rge  (  "  (  % s  }  ” ,  Si  )  ; 

) 

I 

actual_a rgument_l i st  actual_argumer.t 

( 

"f  =  merge!  "%sf%s!",  SI,  S3  ); 

) 


actual_argument : 

expression 

f 

SS  -  SI; 

) 

I 

actual_a  rgument _a 1 ternate_retu -n 
( 

SS  =  SI; 

) 
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actual_argument_alternate_return: 
•*’  INTEGER 
{ 

$$  =  merge)  "*%s",  $2  ); 

) 


return_statement : 

RW_RETURN  opcional_expression 

( 

return_statement (  $2  ) ; 

) 


unconditional_go_to_statement : 

RW_GO  TO  INTEGER 

{ 

unconditional_go_to_statement (  $2  ) 

} 


computed_go_to_statement : 

RW_GO  TO  '('  integer_list  •  >'  optional 

( 

computed_go_to_statement (  $3,  $6  ) ; 

1 


assigned_go_to_statement : 

RW_GO  TO  IDENTIFIER 

( 

assigned_go_to_statement (  $2,  0  ); 

1 

I 

RW_GO  TO  IDENTIFIER  opt ionai_comma 

( 

assigned_go_to_statement (  S2,  $5  ); 

1 


optional  comma: 

/*  NULL  */ 


integer_list : 

INTEGER 

{ 

$3  =  merge)  ")%s/”,  $1  ); 

1 

I 

integer_list  INTEGER 

f 

SS  =  merge)  ”%s(%s)”,  SI,  S3  ); 


pause^statement : 

RW_PAUSE  optional_expression 

( 

pause_statement (  S2  j ; 

1 


stop_statement : 

RW_STOP  opt iona l_express i on 
( 

stop  statement  (  S2  ); 


comma  expression 


integer_list  ' )  ' 
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io_statement : 

ope  restatement 
I 

close_statement 

l 

inquire_statement 

I 

read_statement 

I 

wri te_statement 

I 

print_statement 

I 

backspace_statement 

I 

rewind_statement 

I 

endfile  statement 


open_statement : 

RW_OPEN  '('  control_information_list  ' )  1 

{ 

open_statement (  $3  ) ; 

) 


close_statement : 

RW_CLOSE  1  ('  control_information_list  *)  ' 

{ 

close_statement (  S3  ) ; 

1 


inquire_statement : 

RW_INQUIRE  •('  control  information_list  ■)' 

( 

inquire  statement (  $3  ) ; 

1 


read_statement : 

RW_READ  '('  control_information_list  •)*  optional_io_ll st 
f 

read_statement (  S3,  SS  ); 

) 


RW_READ  control 

( 

read_statement (  $2,  0  )  ; 

1 


RW_RF,AD  control  io_list 

( 

read_statement  (  S2,  S4  ); 

) 


write_statement : 

RW_WRITE  cont roI_i nf ormat ion^l i st  ')’  opt ional_io_l i st 

f 

write_statement (  S3,  S5  ) ; 

) 


print_statement : 

RW_PRINT  control 
( 

pcint_statement (  S2,  0  ); 

i 

i 

RH_PR1M  control  io  list 

( 
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print_statement (  52,  $4  ); 

) 


backspace_statement : 

RW_BACKSPACE  '('  control_information_list  ’)' 

( 

backspace_statement (  S3  ) ; 

) 

I 

RW_BACK SPACE  control 

{ 

backspace_statement (  $2  ) ; 

1 


rewind_statement : 

RW_R£WIND  '('  control_information_list  ')’ 

{ 

rewind_statement (  $3  )  ; 

} 

I 

RW_REWIND  control 

f 

rewind_statement (  $2  ); 

) 


endfile_statement : 

RW_ENDFILE  '('  control_information_list  ')* 

< 

endf ile_statement (  $3  ); 

) 

I 

RW_ENDFILE  control 

{  . 

endfile  statement!  52  ); 

) 


control_in format ion_li st : 

control_information 

f 

55  =  merge!  "{%s)'\  51  )  ; 

) 

I 

control_information_list 

( 

55  =  merge!  51, 

} 


control_in format  ion 
S3  )  ; 


control_inf ormat ion : 
control 
! 

55  =  SI; 

) 

I 

IDENTIFIER  expression 

( 

55  =  merge!  ”%s  =  %s",  51,  S3  ); 

) 


cant  rol : 

variable 

< 

55  = 

1 

I 

constant 

f 

55  = 

1 

I 


51; 


51; 
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i 

SS  =  duplicate!  "*“  ); 

1 


optional  io_list: 

/*  NULL  */ 

( 

$$  =  0; 

1 

io_list 

{ 

S$  =  SI; 

) 


io_list : 

io 

{ 

$S  =  merge!  $1  ); 

) 

I 

io_list  ' ,  1  io 

{ 

$$  =  merge!  "%s{%s}",  SI,  S3  ); 

1 


expression 

{ 

SS  =  SI; 


io_implied_do  list 

( 

$$  =  SI; 

) 


io_implied_do_li st ; 

'('  io  list  IDENTIFIER  ' »•  expression_list  ')' 

( 

SS  ■  impl i ed_do_l i st (  S2.  S4,  S6  ); 

t 


f ormat_statement : 

RW_FORMAT 

( 

format  statement!  $1  ); 

) 


FILE:  ct ime r / include/li st . h 


/’ 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦define  LIST  struct  list_type 
LIST 

( 

char  'identifier; 
char  'block  name; 
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int  number; 
LIST  *next; 

1; 


extern  LIST  *end_list(  ); 
extern  LIST  *add_Iist(  ); 
extern  int  find_list(  ); 
extern  void  print_list(  ); 
extern  void  delete_list(  ); 


FILE:  ctimer/library/Makefile 


# 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


CC  «  cc  -g 
INCLUDE  =  ../include 
CFLAGS  -  -IS (INCLUDE) 
LIBRARY  =  library. a 


OBJECTS  =  \ 
alias. o  \ 
array. o  \ 
count. o  \ 
duplicate. o  \ 
hollerith.o  \ 
implied_do_list . o  \ 
label. o~\  ~ 
link_list.o  \ 
list.o  \ 
lowercase. o  \ 
main.o  \ 

margin_printf .o  \ 
merge. o  \ 
non_blank.o  \ 
parse. o  \ 
print_level . o  \ 
stack. o  \ 
statement.o  \ 
summary. o  \ 
t i me  r . o  \ 
type.o  \ 
yyerror.o  \ 
yygetc.o  \ 
yywrap. o 


S (LIBRARY) : S (OBJECTS) 
rm  -f  S  (LIBRARY) 
ar  crv  S (LIBRARY)  $ (OBJECTS) 
ranlib  $ (LIBRARY) 


.SUFFIXES:  .c  .o 
.  c.  o : 

S (CC)  -c  $ (CFLAGS)  $< 


clean : 

rm  -f  S (LIBRARY)  S (OBJECTS) 


FILE:  ct imer/ 1 ibra ry/al ias .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 
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#include  <stdio.h> 
♦include  <string.h> 


extern  int  yylineno; 
extern  char  ‘duplicate (  ); 
extern  char  ‘lowercase (  ); 


♦define  ALIAS  struct  alias_type 

ALIAS 

l 

char  *old_identifier; 
char  *new_identifier; 

1 ; 


static  ALIAS  alias_table[  ]  = 

( 

{  "«  ) 

}  ; 


♦define  ALIAS  TABLE  (  sizeof)  alias_table  )  /  sizeof (  ALIAS  )  ) 


chai  ‘alias (  identifier  ) 
register  char  ‘identifier; 

{ 

register  int  low,  high; 
register  int  middle,  test; 

lowercase)  identifier  ); 

low  =  0 ; 

high  =  ALIAS_TABLE  -  1; 

while  (  low  <=*  high  ) 

{ 

middle  «  (  low  +  high  )  /  2; 

test  -  strcmp)  identifier,  alias_table(  middle  ] ,old_identifier  ); 

if  (  test  <  0  ) 

( 

high  *  middle  -  1; 
continue; 

1 

if  (  test  >  0  ) 

< 

low  =  middle  +  1; 
continue; 

1 

fprint f  (  stderr,  "line  %d,  %s  aliased  to  %s\n",  yylineno,  identifier,  alias_table 
middle  ]  .  new_ident i f ier  ); 

return)  alias_table[  middle  ) . new_identif ier  ); 

1 


return)  identifier  ); 
)  /»  alias  */ 


FILE:  ctimer/library/array.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  char  ‘list)  ); 
extern  char  'merge)  ); 


char  ‘array)  identifier,  optional_expressicn_list  ) 
register  char  ‘identifier; 
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register  char  *optional_expression_Iist; 

{ 

if  (  opt i ona!_expression_list  !=  (char  ")0  ) 

return  (  merge (  "%s(%s)",  identifier,  list(  opt ional_expression_l i st ,  ",  "  )  )  ); 

else 

return!  merge!  "%sO",  identifier  )  ); 

}  /*  array  */ 


FILE:  ctimer/library/count .c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


int  count!  string,  length,  c  ) 
register  char  "string; 
register  int  length; 
register  char  c; 

( 

register  int  c_count  =  0; 

while  (  length  !=  0  ) 

( 

if  (  "string  ==  c  ) 
c_count++; 

string"--*-; 
length — ; 

} 

return!  c_count  ); 

(  /*  count  */ 


FILE:  ctimer /library/duplicate . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  <malloc.h> 


char  "duplicate!  string  ) 
register  char  "string; 

( 

register  char  "temporary  =  (char  "(NULL; 

if  (  string  !=  (char  *)NULL  ) 

( 

if  (  (  temporary  =  (char  "Imalloc!  strlen!  string  )  +  1  )  )  !=  (char  "Ih'ULL  ) 

strcpy!  temporary,  string  ); 

else 

fprintf!  stderr,  "ERROR:  duplicate!  %s  )\n",  string  ); 

) 


return!  temporary  ); 
)  /*  duplicate  */ 


FILE:  ct imer/1 ibrary /hoi lerith . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
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#include  <stdio.h> 


char  'hollerith!  string,  delimeter  ) 
register  char  'string; 
register  char  delimeter; 

( 

int  hollerith_length; 

register  int  string_length  =  0; 

sscanf (  string,  ”%dh",  Shollerith_length  ); 

string!  string_length++  1  =  delimeter; 

while  (  hollerith_length  !=  0  ) 

if  (  t  string!  string_length  1  =  yyinput!  )  )  ==  '\n*  ) 

< 

yyunput (  string!  string_length  )  ); 

break; 

1 

string_length++; 
hollerith_length — ; 

) 

string!  string_length++  1  =  delimeter; 

string!  string_length  1  =  '\0'; 

return!  string  ); 

)  /*  hollerith  */ 


FILE:  ctimer/library/implied_do_list .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  char  *list(  ); 
extern  char  'merge (  ) ; 


char  *implied_do_list (  variable_list,  identifier,  expression_list  ) 
register  char  *variable_list; 
register  char  'identifier; 
register  char  *expression_list; 

( 

return!  merge!  "(%s,  %s  =  %s) ”,  list!  variable_list,  ",  ”  ),  identifier, 
expression_list,  ",  "  )  )  ) ; 

)  /*  implied_do_list  */ 


FILE:  ctimer/library/label .c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R,  Wachtel 

'/ 


extern  int  level; 


char  'label (  string  ) 
register  char  'string; 

( 

if  (  string  '.  =  (char  *)0  ) 

margin_printf (  ”%d\t",  atoi (  string  )  ) ; 

else 

margin_printf (  "\t"  ); 


list  ( 
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while  (  check_stack (  string  )  !=  0  ) 

{ 

pull_stack(  ); 
level — ; 

> 

return!  string  (; 

}  /*  label  '/ 


FILE:  ctimer/library/link_list.c 


/' 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <malloc.h> 
♦include  "list.h" 


LIST  *end_Iist(  list  ) 
register  LIST  'list; 

( 

if  <  list  ! -  (LIST  * ) NULL  ) 

{ 

while  (  list->next  !=  (LIST  '(NULL  ) 
list  »  list->next; 

) 

return (  list  ); 

(  /*  end_list  */ 


LIST  *add_list(  list,  identifier,  block_name,  number  ) 

register  LIST  **list; 

register  char  'identifier; 

register  char  *block_name; 

register  int  number; 

{ 

register  LIST  'temporary  =  (LIST  *)malloc(  sizeof(  LIST  )  ); 

temporary->identif ier  =  identifier; 
temporary->block_name  =  block_name; 
temporary->number  =  number; 
temporary->next  =  (LIST  '(NULL; 

if  (  'list  ==  (LIST  '(NULL  ) 

'list  =  temporary; 
else 

end_list(  'list  ) ->next  =  temporary; 

return!  temporary  ); 

)  /'  add  list  */ 


int  find_list (  list,  identifier,  block_name  ) 
register  LIST  'list; 
register  char  'identifier; 
register  char  *block_name; 

( 

while  (  list  !=  (LIST  '(NULL  ) 

( 

if  (  (  strcmp(  identifier,  list->identifier  )  ==  0  ) 

Si  (  strcmpl  block_name,  list->block_name  (  ==  0  )  ) 

return)  list->number  ); 

list  =  list->next; 

) 

return (  0  )  ; 

(  /*  find  list  '/ 


void  print_list(  file,  list  ) 
register  FILE  'file; 
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register  LIST  'list; 

( 

while  (  list  !=  (LIST  *)NULL  ) 

( 

fprintf (  file,  “id",  list->number  ); 

if  (  list->bloclc_name  ==  (char  *)NULL  ! 
fprintf  (  file,  “  V'V'"  ); 

else 

fprintf!  file,  "  %s",  list->block_name 

if  (  list->identi fier  ==  (char  ’)NULL  ) 
fprintf  (  file,  ”  \“\n"  ); 

else 

fprintf (  file,  ”  %s”,  list->identif ier 
fprintf (  file,  "\n"  ); 
list  »  list->next; 

) 

}  /*  print_list  */ 


void  delete_list (  list  ) 
register  LIST  *list; 

( 

if  (  list  ! =  (LIST  ' ) NULL  ) 

( 

delete_list(  list->next  ); 
free<  list  ); 

) 

)  /*  delete_list  '/ 


FILE:  ctimer/library/list .  c 


/' 

*  Copyright  1991 

'  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
'  Author:  Stephen  R.  Wachtel 

*/ 


extern  char  'parse (  )  ; 
extern  char  'merge!  )  ; 


char  *list(  input_list,  delimeter  ) 
register  char  *input_list; 
register  char  'delimeter; 

( 

register  char  *cutput_list; 
register  char  'list; 
register  char  'temporary; 

output_list  =  parse (  input_list  ); 
list  »  parse (  input_list  ); 

while  (  list  !=  (char  *)0  ) 

( 

temporary  =  merge)  "%s%s%s",  output_list, 

free(  output_list  ); 

free (  list  ) ; 

output_list  =  temporary; 

list  =  parse!  input_list  ); 

1 

return!  output_list  ); 

)  /'  list  */ 


FILE:  ct imer/ 1 ibrary/ lowercase . c 


/* 


)  ; 


)  ; 


delimeter,  list  ) 


Copyright  1991 
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*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


char  ‘lowercase (  string  ) 
register  char  ‘string; 

{ 

register  int  index  =  0; 

while  (  string!  index  ]  !=  '\0'  ) 

{ 

string!  index  ]  =  tolower (  string!  index  ]  ); 
index++; 

} 

return (  string  ) ; 

}  /*  lowercase  */ 


FILE:  ctimer/library/main.c 


/* 

*  Copyright  1991 

»  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
'*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 


extern  FILE  ‘yyin; 
extern  FILE  ‘yyout; 


♦define  PROGRAM  argument [  0  ] 
♦define  INPUT_FILE  argument!  1  ] 
♦define  OUTPUT_FILE  argument!  2  ) 


int  main(  number_argument,  argument  ) 
int  number_argument; 
char  ‘argument [  ] ; 

( 

if  (  number_argument  ==  1  ) 

! 

yyin  -  stdin; 
yyout  =  stdout; 

yyparse (  ) ; 
exit(  0  ); 

) 


if  (  number  argument  ==  3  ) 

( 

if  (  (  yyin  =  f open (  INPUT_FILE,  “r"  )  )  ==  (FILE  *)NULL  ) 

{ 

fprintf!  stderr,  "%s:  ERROR  -  unable  to  open  input  file  '%s'\n",  PROGRAM, 
INPUT_FILE  ) ; 

exit!  -1  ); 


1 

if  (  (  yyout  =  fopen (  OUTPUT_FILE,  "w"  )  )  ==  (FILE  *)NULL  ) 

i 

fprintf!  stderr,  "%s:  ERROR  -  unable  to  open  output  file  '%s’\n",  PROGRAM, 
OUTPUT_FILE  1; 

exit (  -1  ) ; 

1 


yyparse!  ) ; 
exit  (  0  )  ; 

) 

fprintf!  stderr,  "usage:  %s  cinput  fiie>  <output  file>\n",  PROGRAM  ) ; 
exit  (  0  )  ; 

>  / *  main  * / 
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FILE:  ctimer/library/margin_print f . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

'/ 


♦include  <stdio.h> 
♦include  <string.h> 


extern  FILE  *yyin; 
extern  FILE  'yyout; 


static  char  buffer [  256  *  20  ]  =  {  0  (; 


static  void  output_buf fer (  file  ) 
register  FILE  'file; 

i 

♦define  LENGTH  12 

int  length  =  LENGTH; 
int  continuation  =  0; 
int  quote  =  0; 
char  temporary; 

while  (  strlen!  buffer  )  >  length  ) 

( 

if  (  continuation**  !=  0  ) 

fprintf (  file,  "  t"  ); 

quote  +=  count!  buffer,  length,  'S''  ); 
if  (  <  quote  *  2  )  ==  0  ) 

( 


.  le 

(  length  ! 

=  0  ) 

if 

(  buffer! 
break; 

length  -  0  ] 

:  *\ 

if 

(  buffer! 
break; 

length  -  0  ] 

==  ’  \ 

if 

(  buffer! 
break; 

length  -  1  ] 

1  ==  •  \ 

length--; 

> 

if  (  length  ==  0  ) 

{ 

fprintf!  stderr,  "ERROR:  margin_printf 0 \n"  ); 
exit  (  -1  ) ; 


) 

temporary  =  buffer^  length  ]; 
buffer (  length  )  »  '\0'; 
fprintf!  file,  "%s\n",  buffer  ); 
buffer!  length  1  =  temporary; 

strepy!  Sbuffer[  0  ],  sbuffer[  length  ]  ); 
length  *  LENGTH  -  6; 

} 

if  (  strlen!  buffer  )  !=  0  ) 

( 

if  (  continuation**  !=  0  ) 

fprintf (  file,  "  i "  ) ; 

fprintf!  file,  "%s\n",  buffer  ); 

> 

)  /*  output_buf fer  */ 
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char  "format; 
int  a,  b,  c,  d,  e; 

{ 

char  temporary [  256  *  20  ); 

sprintf!  temporary,  format,  a,  b,  c,  d,  e  ); 
strcatf  buffer,  temporary  ); 

if  (  buffer!  strlen(  buffer  )  -  1  1  ==  ‘\n*  ) 

( 

buffer!  strlen!  buffer  )  -  1  J  =  '\0'; 

while  (  buffer!  strlen!  buffer  )  -  1  ]  ==  •  '  ) 
buffer!  strlen!  buffer  )  -  1  )  =  ‘\0*; 

switch  (  buffer!  0  1  ) 

( 

case  1 \0 ' : 

fprintf!  yyout,  "\n"  ); 
break; 

case  ' *  '  : 
case  ' c‘ ; 
case  ' C'  : 

fprintf!  yyout,  "%s\n",  buffer  ); 
break; 

default : 

output_buf fer  (  yyout  ); 

> 

buffer!  0  ]  =  '\0'; 

) 

)  /*  margin_printf  »/ 


FILE:  ctimer/library/merge . c 


/» 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  <malloc.h> 


♦define  STRLEN!  s  )  (  strlen!  s  )  -  2  ) 


char  "merge!  string,  a,  b,  c,  d  ) 

register  char  "string; 

register  char  "a; 

register  char  *b; 

register  char  *c; 

register  char  *d; 

( 

register  char  "temporary  =  (char  "(NULL; 

switch  (  count!  string,  strlen!  string  ),  )  ) 

( 

case  0: 

if  (  (  temporary  =  (char  "Imalloc!  strlen!  string  )  +  1  )  )  !=  (char  *)NULL  ) 

sprintf!  temporary,  string  ); 

else 

fprintf!  stderr,  "ERROR:  merge!  %s  ) \n”,  string  ); 

break; 

case  1: 

if  (  (  temporary  =  (char  "Imalloc!  strlen!  string  )  +  STRLEN!  a  )  *  1  )  )  ! » 

(char  * ) NULL  ) 

sprintf!  temporary,  string,  a  ) 

else 

fprintf!  stderr,  "ERROR:  merge!  %s,  %s  )\n",  string,  a  ); 

break; 
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case  2: 

if  (  (  temporary  =  (char  *)malloc<  strienl  string  )  +  STRLEN l  a  *  *  STRLEN (  b 

)  +  1  )  )  ! =  (char  *)NULL  ) 

sprintfl  temporary,  string,  a,  b  ); 

else 

fprintf(  stderr,  "ERROR:  me ;ge  '  %s,  %s,  %s  )\n”,  string,  a,  b  ); 
break; 

case  3: 

if  (  (  temporary  =  (char  "imailoc!  strienl  string  )  +  STRLEN!  a  )  +  STRLEN!  b 
)  +  STRLEN (  c  )  +  1  )  )  !=  (char  *)NULL  ) 

sprintfl  temporary,  string,  a,  b,  c  ); 

else 

fprintf (  stderr,  "ERROR:  merge!  %s,  %s,  %s,  %s  )\n",  string,  a,  b,  c  ); 

break; 

case  4: 

if  (  (  temporary  =  (char  "imalloc!  strlen!  string  )  +  STRLEN!  a  )  *  STRLEN!  b 
)  +  STRLEN  (  c  )  +  STRLEN  (  d  )  +  i  )  )  .’ =  (char  *)  NULL  ) 

sprintf(  temporary,  string,  a,  b,  c,  d  ); 

else 

fprintf  (  stderr,  "ERROR:  merge!  %s,  %s,  %s,  %s,  %s  )  \n",  string,  a,  b,  c,  d 

); 

break; 
default : 

fprintf!  stderr,  "ERROR:  merge!  %s  )\n",  string  ); 
break; 

) 


return!  temporary  ); 
)  /*  merge  */ 


FILE:  ct imer/library/non_blank.  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


#include  <string.h> 


char  *non_blank(  string  ) 
register  char  "string; 

( 

register,  int  offset1 
registt  ■  int  length; 

length  =  strlen!  string  )  -  1; 

while  (  (  string!  length  1  «»  1  1  )  ii  (  string!  length  i 
string!  length--  )  =  ’NO’; 

offset  =  0; 

while  (  (  string!  offset  )-=■’’)  a  (  string!  offset  ! 

string!  offset-*--*-  ]  *  ’NO’; 

frcpy!  string,  Sstring!  offset  )  ); 


if  (  strlen!  string  )  ! -  0  ) 

return!  string  ) ; 

else 

return  (  °  ) ; 

!  /  '  non  blank  *  / 


•\0’  )  ) 

•NO’  )  ) 


FILE:  ct imer/i ibrary /parse . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Comp*.. ter  Engineering  Research  laboratory 

*  Author:  Stephen  R.  Wachtel 

'/ 


10.  Appendix  E:  ctimer  program  source 


77 


♦include  <string.h> 
extern  char  ’duplicate!  ); 


char  ’parse!  list  ) 
register  char  ’list; 

{ 

register  int  length  =  0; 

register  int  brace  =  0; 

register  char  ’temporary  =  (char  ’)0; 

for  (;;) 

! 

switch  (  list[  length  j  > 

/ 

case  '  (  '  : 

brace”  ; 
break; 

case  1 ) 1 : 

brace--; 

break; 

) 

if  (  brace  ==  0  ) 
b-eak; 

length”; 

i 

if  (  length  !=  0  ) 

( 

list[  length  ]  =  '\0'; 

temporary  =  duplicate!  list  +  1  ); 

strcpy!  list,  list  +  1  +  length  ); 

} 

else 

( 

if  (  list[  length  ]  !=  ■  \ 0 ■  ) 

{ 

temporary  =  duplicate!  list  ); 
list[  length  ]  =  '\0'; 

) 

) 

return!  temporary  ); 

}  /’  parse  */ 


FILE;  ctimer/library/print_levei .c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author;  Stephen  R.  Wachtei 

*/ 


int  level  =  0; 


void  print_ievei (  level  ) 
register  i nt  level; 

if  (  level  -  0  ) 

I 

while  ;  level--  ’=  0  ) 

marginp  intf f  "  "  ); 

) 

*  / *  print  1  eve  1  *  I 

FILE:  ct 1  me r / 1 i bra ry / st acx  .  c 


/* 
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*  Copyright  1991 

*  Georgia  Institute  cf  Technology 

*  Computer  engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 
*/ 


extern  int  level; 


Idefine  STACK  128 
static  struct 
{ 

char  ’label; 

}  stack [  STACK  ]; 
static  int  pointer  *  0; 


int  push_stack (  label  ) 
register  char  ’label; 

{ 

if  (  pointer  !=  STACK  ) 

{ 

stack!  pointer  ]. label  =  label; 

pointer+t; 
return!  1  ); 

1 

return (  0  ) ; 

)  /*  push_stack  ’/ 


int  check_stack(  label  ) 
register  char  ’label; 

i 

if  (  pointer  !=  0  ) 

{ 

if  (  strcmp!  stack!  pointer  -  1  ]. label,  label  )  ==  0  ) 
return  (  1  ) ; 

) 


return (  0  ) ; 

}  /*  check  stack  */ 


int  pull_stack(  ) 

( 

if  (  pointer  !=  0  ) 

i 

pointer--; 

free!  stack!  pointer  J. label  ); 
return (  1  ) ; 

) 

return (  0  ) ; 

)  /*  pull_stack  */ 


FILE:  ct imer/ 1 ibrary /statement .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 

'/ 


void  statement (  label  ) 
register  char  ’label; 

< 

)  /*  statement  */ 


FILE:  ct rmer/1 ibra ry/summa ry . c 
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*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 
♦include  "list.h" 


extern  LIST  'call  list; 


void  summary (  ) 

{ 

print_list (  stdout,  call_iist  ); 
(  /*  summary  */ 


FILE:  ctimer/library/timer .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  "list.h" 


extern  int  level; 


LIST  *call_list  =  (LIST  *)NULL; 
char  *block_name; 
int  timer  number  =  0; 


void  block (  identifier  ) 
register  char  'identifier; 

< 

block_name  =  identifier; 
}  /*  block  */ 


int  timer!  comment  ) 
register  char  'comment; 

( 

if  (  strncmpl  comment,  "'LOOP'",  6  )  '=  0  ) 

return (  0  )  ; 

if  (  strcmp!  comment,  "'LOOP*  PROLOGL'EXn"  )  ==  0  ) 

( 

label (  0  ) ; 
print_level (  level  ) ; 

margin_printf (  "CALL  t imer_prologue ( ) \n"  ); 
return (  1  ) ; 

) 

if  (  strcmpl  comment,  "'LOOP*  START\n"  )  =—  0  ) 
return  (  1  )  ; 

if  (  strcmp(  comment,  "'LOOP*  Stf^Vn"  )  -=  0  ) 
return!  1  ) ; 

if  (  strcmp!  comment,  "'LOOP*  EPILOGLFVn"  )  ==  C  ) 

i 

label!  C  ) ; 
prir.t_level(  level  ); 

marg:  r.  pr  int  f  (  "CALL  i  i  me r  ep :  1  ogue  ( :  \ r."  I  ; 
return (  1  ) ; 
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}  / 


return ( 
*  timer 


0 

*/ 


)  ; 


void  start_timer(  identifier  ) 
register  char  'identifier; 

( 

add_list(  Scall_list,  identifier,  block_name,  +»t imer_number  ); 
print_level  (  level  )  ; 

margin_printf (  "CALL  start_timer (%d) \n“,  timer_number  ); 
label (  0  ) ; 

}  /'  start  timer  '/ 


void  stop_timer(  identifier  ) 
register  char  'identifier; 

( 

label (  0  )  ; 
print_level (  level  ) ; 

margin_print f (  "CALL  stop_timer ( %d) \n" ,  timer_number  ); 
)  /*  stop_timer  '/ 


FILE:  ctimer/library/type.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

'/ 


extern  char  'merge!  ); 


char  'type!  type_name,  opt iona i_type_length  ) 

register  char  'type_name; 

register  char  *optional_type_length; 

1 

if  (  optional_type_length  !=  (char  *!0  ) 

return!  merge!  "ts%s",  type_name,  opt ionai_type_iengtn  )  ); 

else 

return!  type_name  ); 

!  /*  type  */ 


FILE:  ct imer/1 ibrary /yyerror . c 


/' 

*  Copyright  1991 

'  Georgia  Institute  of  Technology 
'  Computer  Engineering  Research  Laboratory 
'  Author:  Stephen  R.  Wachtel 

'/ 


itinclude  <stdio.h> 


extern  int  yylineno; 


void  yyerror!  string  ) 
register  char  'string; 

( 

fprintf!  stderr,  "Iir->  %d,  %s\n",  yyiineno,  string  ); 

exit  (  -1  i  ; 
t  /'  yyerror  '/ 


FILE:  ct ime r/ 1 ibra ry /yyget c . c 


/' 

*  Copyright  1991 

'  Georgia  Institute  of  Technology 
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*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 
♦include  <ctype.h> 


extern  int  yylineno; 


int  tab(  length  ) 
register  int  length; 

{ 

while  (  length —  !=  0  ) 
yyunput (  1  '  ) ; 

return (  1  '  ) ; 

}  /*  tab  */ 


int  yygetc!  file  ) 
register  FILE  'file; 

f 

int  c; 

int  column [  6  ]; 
loop: 


if 

(  (  c  =  getc!  file  )  ) 

==  1 \t '  ) 

if 

c  =  tab (  6  )  ; 

(  c  !=  ' \n'  ) 

if 

return (  c  ) ; 

(  (  column!  0  ]  =  getc( 

file  )  )  != 

if 

goto  abort  0; 

(  (  column!  1  ]  =  getc( 

file  )  )  !  = 

if 

goto  abort_l; 

(  (  column!  2  ]  =  getc( 

file  )  )  != 

if 

goto  abort_2; 

(  (  column!  3  )  =  getc! 

file  )  )  ! = 

if 

goto  abort_3; 

(  (  column!  4  )  =  getc! 

file  )  )  != 

if 

goto  abort  4; 

(  isspace!  column!  5  ] 

=  getc!  file 

goto  abort_5 


yylineno++; 
goto  loop; 

abort_5 : 

if  (  column!  5  ]  =  =  '\t'  ) 
tab (  1  ); 

else 

( 

yyunput!  column [  5  1  ); 
if  (  column!  5  ]  ==  '\n'  ) 
yyl ineno++; 

) 


abort_4 : 

if  (  column!  4  ]  =-  *\t‘  ) 
tab!  2  ) ; 

else 

( 

yyunput!  column!  1  ]  I; 
if  (  column!  4  )  ==  ' \n'  ) 
yy  1  i  ner.o+t  ; 

! 


abort  3 : 

it  (  column!  3  ]  -= 
tab!  3  ) ; 

else 


f 


yyunput!  column! 
if  (  column!  3 
yy 1 ineno*» ; 


•\t‘ 


3 


) 


)  ; 


) 
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abort_2: 

if  (  column!  2  ]  ==  '\t'  ) 
tab (  A  ); 
else 
1 

yyunput (  column!  2  ]  ); 
if  (  column!  2  ]  ==  1 \n*  ) 
yy 1 ineno++; 

} 

abort_l : 

if  (  column!  1  1  ==  ' \t 1  ) 
tab  (  5  ) ; 

else 

{ 

yyunput (  column!  1  }  ); 
if  (  column!  1  )  ==  '\n'  ) 
yylineno++; 

I 

abort_0 : 

if  (  column!  0  ]  ==  '  \t'  ) 
tab (  6  ) ; 
else 

{ 

yyunput!  column!  01); 
if  (  column!  0  ]  ==  '\n'  ) 
yylineno++; 

} 

return (  c  ) ; 

)  /*  yygetc  */ 


FILE;  ctimer/library/yywrap. c 


/* 

*  Copyright  1931 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


int  yywrap!  ) 

{ 

return (  1  ) ; 
)  /*  yywrap  */ 


FILE:  ctimer/scanner . 1 


%f 

/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 

%) 


%a  10000 
%e  10000 
*K.  10000 

tn  10000 
»o  10000 

%p  10000 


a  [aA] 
b  [  bB  1 
c  [cCJ 
d  [dD] 
e  [eE] 
f  [fFJ 
g  [oc; 
h  ( hH ) 
i  fit! 
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3  1 3  J) 
k  [  kK  ] 

1  [1L1 
m  (mMl 
n  [nN] 
o  [oO] 
P  [pP] 
q  [qOI 
r  [rR] 
s  [  sS  1 
t  [tTl 
u  [uU] 
v  [W] 
w  [wWJ 
x  [xX] 
y  tyYi 

2  [zZ} 


*( 

♦include  "grammar. h" 
extern  char  *yylval; 


♦undef  YYLMAX 
♦define  YYLMAX  (256*20) 


extern  char 
extern  char 
extern  char 
extern  char 

%} 


•duplicate  (  ) 
*hollerith(  ) 
*non_blank(  ) 
•alias  (  ) ; 


%% 


-[\*cCI . *  C \n J  I 
lM\n]  ( 

♦ifdef  DEBUG 
ECHO; 

♦endif 

yylval  =  duplicate)  yytext  ); 
return (  COMMENT  ); 

) 


[\  1  { 

♦ifdef  DEBUG 
ECHO; 

♦endi f 

/*  return (  ' \  '  )  */; 

} 


[\«1  { 

♦ifdef  DEBUG 
ECHO; 

♦endi f 

return  (  ' \s  '  )  ; 

) 


C\C  ( 

♦ifdef  DEBUG 
ECHO; 

♦endi f 

return  (  ’  \  ( ’  )  ; 
I 


[\)1  ( 

♦ifdef  DEBUG 
ECHO; 

♦endi f 

return  (  '  \)  '  )  ; 

) 


( 
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# ifdef  DEBUG 
ECHO; 
iendi f 

return (  ' \*‘  ); 

) 


iifdef  DEBUG 
ECHO; 

#endif 

return  (  EXPONENTIATE  ); 

} 


C\+)  < 

# ifdef  DEBUG 
ECHO; 
lendi f 

return  (  ' \+ '  )  ; 

i 


(\,  1  ( 

# ifdef  DEBUG 
ECHO; 
lendi f 

return  (  '  \  ,  '  )  ; 

) 


t\-l  { 

# ifdef  DEBUG 
ECHO; 

#endif 

return (  ‘ \- 1  ); 

) 


C\ - ]  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  ' \ . '  ) ; 

} 


[\/l  f 
# ifdef  DEBUG 
ECHO; 
lendif 

return (  •  \ / *  )  ; 

} 


t\:)  ( 

# ifdef  DEBUG 
ECHO; 

#endi f 

return  (  '  \ :  '  )  ; 

> 


t\-l  ( 

# i f de  f  DEBUG 
ECHO; 

Kendi f 

return  (  ' \  =  ’  ) ; 

) 


( \n)  { 

» ifdef  DEBUG 
ECHO; 

#endi f 

/*  return (  • \n '  )  * /; 

! 


[\tl  ! 

Iifdef  DEBUG 
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ECHO; 

tendif 

/*  return  (  ' \t 1  )  */; 

} 


[\.l  ia)(n](dl [\ - ]  { 

tifdef  DEBUG 
ECHO; 

#endi£ 

return  (  RW_AND  ) ; 

) 


tifdef  DEBUG 
ECHO; 
tendif 

return  (  RW_EQ  ); 

} 


[\.]|e|(ql|vl(V.)  { 

tifdef  DEBUG 
ECHO; 
tendif 

return (  RW_EQV  ); 

} 


[\.M£Halil)(s){e)t\.]  { 

tifdef  DEBUG 
ECHO; 
tendif 

return  (  RW_FALSE  ) ; 

) 


l\.l(gHeH\.l  ( 

tifdef  DEBUG 
ECHO; 
tendif 

return)  RW_GE  ); 

) 


E\.l(g)(t) [\.]  ( 
tifdef  DEBUG 
ECHO; 
tendi  f 

return)  RW_GT  ); 

) 


[ \  .  1  { 1  He)  t  \ .  1  ( 
tifdef  DEBUG 
ECHO; 
tendi f 

return (  RW_LE  ) ; 

) 


[\.] (l)(t> [\.]  ( 
tifdef  DEBUG 
ECHO; 
tendif 

return)  RW_LT  ); 

) 


[\. ]  (n) (e>  [\.  1  ( 

tifdef  DEBUG 
ECHO; 
tendi  f 

return (  RW_NE  ) ; 

} 


[\. 1 (n) )e) ( q) ( v } [ \ .  ]  ) 

tifdef  DEBUG 
ECHO; 
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lendi f 
} 


return)  RW_NEQV  ); 


[\.HnHo|(t|[\.l  { 

#ifdef  DEBUG 
ECHO; 
lendif 

return (  RW_NOT  ) ; 

1 


(U(oKr|[\.l  { 
lifdef  DEBUG 
ECHO; 

#endi f 

return)  RW_OR  ); 

1 


[\.]{t)fr)(u)(e}[\.]  { 

lifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_TRUE  ) ; 

1 


(a|(s|(3)(iHqHn)  { 
lifdef  DEBUG 
ECHO; 

#endif 

return)  RW_ASSIGN  ); 

1 


(bl(a){cl(k}(sl(p)UKcHel  ( 
#i fdef  DEBUG 
ECHO; 

#endi f 

return)  EW_BACKSPACE  ); 

1 


(b)  (I)  (o(  {cl  )k)  {\  l*(dHaHt||a|  { 
#i fdef  DEBUG 
ECHO; 

#endi  f 

return)  RW_BLOCK_DATA  ); 

I 


(cHaHll)l!  ( 
lifdef  DEBUG 
ECHO; 
lendi f 

return)  RW_CALL  ); 

I 


(c|{h|(a|(rHa|(.Ht|{e)(r|  { 

lifdef  DEBUG 
ECHO; 
lendi f 

return)  RW_CHARACTER  ); 

I 


(clfllloHsHel  ) 
lifdef  DEBUG 
ECHO; 
lendi  f 

return  )  RW_CLOSE  ) ; 

I 


(c)  foMm)  (m)  (o)  fn|  { 
lifdef  DEBUG 
ECHO; 
lendi f 
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return)  RW_COMMON  ); 

) 


{ c }  { o }  (m)  (plUHel  )x)  ( 

#ifdef  DEBUG 
ECHO; 

#endi f 

return)  RW_COMPLEX  ); 

) 


(cKoHnUtHiHnUuXe)  ( 
difdef  DEBUG 
ECHO; 
dendi f 

return (  RW_CONTINUE  ) ; 

) 


(d)(a)(t}{a)  { 

(tifdef  DEBUG 
ECHO; 
dendif 

return  (  RW_DATA  ) ; 

) 


(d,( i ) (m) (e) (n) { s) (i ) (o) (n)  { 

difdef  DEBUG 
ECHO; 

#endif 

return)  RW_DIMENSION  ); 

} 


Idl(o)  ( 

# i fdef  DEBUG 
ECHO; 

#endif 

return)  RW_DO  ); 

) 


(d)(o) |u)(b|(l)(e)  [\  l*{p)(r)(e)(c)(i)(s)(i)(o)(n)  ( 

#i fdef  DEBUG 
ECHO; 

((endi  f 

return)  RW_D0UBLE  PRECISION  ); 

) 


(e)(l)(s)(e)  ( 

(tifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_ELSE  ) ; 

) 


(e) ( 1 ) (s) (e) (\  )»(i)(f)  ( 

# i fdef  DEBUG 
ECHO; 
dendi  f 

return)  RW_ELSE_IP’  ); 

> 


( e  X  n )  ( d)  ( 

I i fdef  DEBUG 
ECHO; 

Itendi  f 

return (  RW_END  ) ; 

) 


(e) (n) !d) (\  )*(i)(f)  ( 

(tifdef  DEBUG 
ECHO; 
dendi f 

return (  RW  END  IF  ) ; 
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) 


( e)(  n)(d}(  f ){  i  H  1  He)  { 
#ifdef  DEBUG 
ECHO; 

#endi f 

return (  RW_ENDFILE  ); 

} 


(e )  (n)  ( t )  ( r )  (y )  ( 

(tifdef  DEBUG 
ECHO; 

(tendif 

return (  RW_ENTRY  ) ; 

1 


(e)  (qllu)|lKvHa)(l)(eHnHc)|e|  ! 
tifdef  DEBUG 
ECHO; 

#endif 

return (  RW_EQUI VALENCE  ) ; 

) 


(el(xHtHe)|r)(n!U)H)  { 
(tifdef  DEBUG 
ECHO; 

(tendif 

return (  RW_EXTERNAL  ); 

) 


|f)(o)lr)|m)U)it).*  1 

(tifdef  DEBUG 
ECHO; 

#endi f 

yylval  «  duplicate (  yytext  ); 
return  (  RW  FORMAT  ) ; 


(f)(u)(n)(c)(t)(i)(o)(n)  ( 

(tifdef  DEBUG 
ECHO; 

#endi f 

return (  RW_FUNCTION  ) ; 

) 


(gHo)  t\  ]  *(t)(o>  i 
Itifdef  DEBUG 
ECHO; 

(tendi  f 

return (  RW_GO_TO  ) ; 

) 


(  i  1  (  f )  ( 

# i fdef  DEBUG 
ECHO; 

Itendi  f 

return (  RW_IF  ); 

1 


lilCnllpmiliHcmutl  ( 
(tifdef  DEBUG 
ECHO; 

Itendi  f 

return (  RW_IMPLICIT  ) ; 

) 


(i)(n)(c){l)(u)(d)(e)  ( 

# i fde  f  DEBUG 
ECHO; 

#endi  f 

return!  RW  INCLUDE  ); 
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I 


(  iHnHql  lull  i  1  (  r  Me)  { 
♦ifdef  DEBUG 
ECHO; 

♦endif 

return (  RW  INQUIRE  ) ; 

} 


(i)lnKt|(eHgHe}(ri  < 
♦ifdef  DEBUG 
ECHO; 

♦endif 

return  (  RW_INTEGER  ) ; 

) 


li)(n)ltHt)(iHnHsHi)ic}  ( 
♦ifdef  DEBUG 
ECHO; 
tendif 

return (  RW_INTRINSIC  ); 

) 


(l](oMgl{i)(c)(a)(l)  { 

♦ifdef  DEBUG 
ECHO; 

♦endi f 

return (  RW_LOGICAL  ); 

) 


|n)U]|mHe||ll(i)(s|(t)  { 

♦ifdef  DEBUG 
ECHO; 

♦endi f 

return  (  RW_NAMELIST  ); 

1 


(oMpMeKnt  ( 

♦ifdef  DEBUG 
ECHO; 

♦endif 

return (  RW_OPEN  ); 

1 


(p)(a)frl(a)(m)(e!(t)!e)(rl  ( 

♦ifdef  DEBUG 
ECHO; 

♦endi f 

return!  RW_PARA METER  ); 

( 


!p) (a) { u } !s) {e!  ( 

♦ifdef  DEBUG 
ECHO; 

♦  endi  f 

return!  RW_PAUSE  ); 

) 


(pl(r)(i)(n)(tt  ( 

♦ifdef  DEBUG 
ECHO; 

♦endi f 

return!  RW_PRINT  ); 

) 


(pi (rl (o) (g) (r) (a) (m(  ( 

♦ifdef  DEBUG 
ECHO; 

♦endif 

return!  RW_PROGRAM  ); 

> 
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IriieMaildi  ( 

♦ifdef  DEBUG 
ECHO; 

♦endi f 

return  (  RW_READ  ) ; 

} 


IrMeHallll  { 

♦ifdef  DEBUG 
ECHO; 

♦  endi f 

return (  RW_REAL  ); 

} 


(  r)  (e  1 1 1  >  {u  j  {  r)  ( n|  ( 

# ifdef  DEBUG 
ECHO; 

♦endif 

return (  RW_RETURN  ) ; 

) 


!r((e) (w) ( i) (n) (d)  ( 

(f  ifdef  DEBUG 
ECHO; 

(fendi  f 

return  (  RW_REWIND  ); 

} 


(s) (a) (v) (e)  { 

#i fdef  DEBUG 
ECHO; 

(tendi  f 

return (  RW_SAVE  ); 

> 


(sHt)ioHpl  1 
# ifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW  STOP  ); 

) 


(sHu|Uj}|rl|oHu)|t|!i|(nKe) 
♦ifdef  DEBUG 
ECHO; 

♦endi f 

return (  RW_SUBROUTINE  >; 

1 


{ 1 1  { h }  ( e  |  {  r. )  f 
♦ifdef  DEBUG 
ECHO; 

♦endi f 

return!  RW_THEN  ); 

) 


(t)|o)  { 

♦ifdef  DEBUG 
ECHO; 

♦endi f 

return!  RW_TO  I ; 

I 


{ w  t  f  r  M  i  )  f  t  H  e  :•  i 

♦ifdef  DEBUG 
ECHO; 

♦  er.dif 

return!  RW  WRITE  ); 

1 
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(uHnHdl(eHfHi|[n|(eHd!  f 
# i f de  f  DEBUG 
ECHO; 

#endi f 

return!  RW_UNDEFIN’ED  ); 

) 


[ %a-zA-Z ) [_a-zA~Z0-9] *  f 
# i fdef  DEBUG 
ECHO; 

#endif 

yylval  =  duplicate!  alias!  yytext  )  ); 

return!  IDENTIFIER  ); 

} 


" [0-9  1 [0-9  1 [0-9  ] [0-9  1 [0-9  ) [\  ]  ( 

#i fdef  DEBUG 
ECHO; 
tendif 

yylval  =  duplicate!  non_blank(  yytext  )  ); 

return (  LABEL  ) ; 

1 


[0-91+  I 

[0-9]+/\. [a-zA-Zl+\.  { 

#ifdef  DEBUG 
ECHO; 

#endi f 

yylval  =  duplicate!  yytext  ); 
return!  INTEGER  ); 

1 


[0-9] +\. [0-91  * ( [eE]  [\  +  \-] ? [0-9J  +) ? 
[0-9] *\. [0-9]+ ( [eE] [\+\-] ? [0-9] +) ? 

[ 0-9]  +  (  [eE]  [\  +  \  —  ] ?  [0  —  9] +) ?  [ 

#ifdef  DEBUG 
ECHO; 

(tendi  f 

yylval  =  duplicate!  yytext  ); 
return (  REAL  ) ; 


[0-9] +\ . [0-9) - ( [dD] [\+\-l ? [0-91 +) ?  I 
[0-9]  *\.  [0-9]  +  (  [dD ]  [\  +  \-]  ?  [ 0- "> ]  + )  ?  | 
[0-9]  +  ( [dD]  [\  +  \-] ? [0-9] +) ?  { 

# i fdef  DEBUG 
ECHO; 

#endi f 

yylval  =  duplicate!  yytext  ); 
return!  DOUBLE_PRECISION  >; 

I 


\  •  ['‘X  '  ]  *\ '  I 
\"["\"]*\"  ( 
#ifdef  DEBUG 
ECHO; 

#endif 

yytext [ 
yytext [ 
yylval 
return  ( 

) 


[0-9] + [hH]  ( 

#ifdef  DEBUG 
ECHO; 
lend!  f 

yylval  =  duplicate!  hollerith!  yytext,  )  ); 

return!  HOLLERITH  ); 

I 


0  1  =  •  \  ; 

strlen!  yytext  )  -  1  ]  =  ’ \ 1 
=  duplicate!  yytext  ); 

STRING  ) ; 


FILE: 


ement /Make  f i le 
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# 

#  Copyright  1 "91 

#  Georgia  Inst.  :ute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


CC  =  cc  -g 
INCLUDE  =  . . /include 
CFLAGS  =  -IS (INCLUDE) 
LIBRARY  =  statement. a 


OBJECTS  =  \ 

arithmet ic_i f_statement .  o  \ 
assign_statement . o  \ 
assigned_go_to_statement . o  \ 
assignment_statement . o  \ 
backspace_statement . o  \ 
block_data_statement .  o  \ 
block_if_statement  .o  \ 
call_statement .o  \ 
close_statement .  o  \ 
comment_statement . o  \ 
common_statement . o  \ 
computed_go_to_statement .  o  \ 
continue_statement .  o  \ 
data_statement . o  \ 
declaration_statement . o  \ 
dimension_statement .  o  \ 
do_statement . o  \ 
else_i f_statement .  o  \ 
el se_statement .  o  \ 
end_i f_statement . o  \ 
end_statement . o  \ 
endf i le_statement . o  \ 
ent ry_statement .  o  \ 
equivalence_statement .  o  \ 
external_statement .  o  \ 
f ormat_statement . o  \ 
function_statement .  o  \ 
implicit_statement . o  \ 
include_statement . o  \ 
inquire_statement . o  \ 
intrinsic_statement .o  \ 
logical_i f_statement . o  \ 
namel i st_statement .  o  \ 
open_statement . o  \ 
parameter_statement . o  \ 
pause_statement . o  \ 
print_statement . o  \ 
program_statement . o  \ 
read_statement .  o  \ 
return_statement .  o  \ 
rewind_statement . o  \ 
save_statement .  o  \ 
stop  statement .  o  \ 
subrout ine_statement . o  \ 
unconditional_go_to_statement . o  \ 
write  statement. o 


S (LIBRARY) : S (OBJECTS) 
rm  -f  $ (LIBRARY) 
ar  crv  $ (LIBRARY)  $  (OBJECTS) 
ranlib  $ (LIBRARY) 


■SUFFIXES:  .c  .0 
.  c .  o : 

$(CC)  -c  $  (CFLAGS)  S< 


clean : 

rm  -f  S (LIBRARY)  S (OBJECTS) 


FILE:  ctimer/statement/arithmet ic  if  statement. c 
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/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  *list(  ); 


void  arithmetic_i f_statement (  expression,  labei_list  ) 
register  char  ‘expression; 
register  char  ‘label_Iist; 

l 

print_level (  level  ) ; 

margin_printf (  "IF  (%s)  %s\n",  expression,  list(  label_lisc,  ",  "  )  ) 

}  /*  arithmetic  if  statement  */ 


FILE :  ct imer/st atement /assign_st atement . c 


/» 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 


void  assign_stetement (  label,  identifier  ) 
register  char  ‘label; 
register  char  ‘identifier; 

1 

print_level (  level  ); 

margin_print f  (  "ASSIGN  %s  TO  %s\r.",  label,  identifier  ); 
}  /*  assign_statement  */ 


FILE:  ctimer/statement/assigned  go_to_statement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  *list<  ); 


void  assigned_go_to_statement (  identifier,  optional  Label_list  ) 
register  char  ‘identifier; 
register  char  *optional_label_l ist; 

( 

if  (  optional_label_list  !=  0  ) 

( 

print_level (  level  ); 

margin_print f (  "GO  TO  %s,  (%s)\n",  identifier,  list(  optional  label  list,  ",  "  ) 

)  ; 

) 

else 

( 

print_level (  level  ) ; 

margin_printf (  "GO  TO  %s\n",  identifier  ); 

) 

\  /*  assigned_go  ro_statement  */ 


FILE:  c t imer/st a  t emen t /assi gnment_st a Cement .  c 
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/* 

*  Copyriqht  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 


void  assignment_statement (  variable,  expression  ) 
register  char  ’variable; 
register  char  ’expression; 

( 

print_level (  level  ) ; 

margin_print f (  "%s  =  %s\n",  variable,  expression  ); 
i  /’  assignment_statement  */ 


m.E:  ct imer/ statement /backspace_st at ement .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  *list(  ); 


void  backspace_statement (  control_list  ) 
register  char  ’control_list; 

( 

print_level (  level  )  ; 

margin_print f (  "BACKSPACE  (»s)\n",  list(  control_li st ,  ",  "  )  ) 

}  /’  backspace_statement  »/ 


FILE:  ctimer/statement/block  data  statement. c 


/* 

*  Copyright  1991 

*  G.eorgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 


void  block_data_statement (  identifier  ) 
register  char  ’identifier; 

( 

print_level (  level  )  ; 

margin_printf (  "BLOCK  DATA  %s\n",  identifier  ) ; 
}  /*  block  data  statement  */ 


FILE:  ctimer/statement/block  if  statement. c 


/* 

’  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 


void  block_i f _statement (  expression  ) 
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register  char  "expression; 

{ 

print_levei (  level  ); 

margin_printf (  "IF  ( % s )  THENVn",  expression  ); 
ievel++; 

)  /*  block  if  statement  */ 


FILE:  ctimer/statement/call  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  SteDhen  R.  Wachtei 

*/ 


extern  int  level; 
extern  char  *list(  ); 


void  cal l_statement (  identifier,  optional_actual_argument_iist  ) 
register  char  »i  dent- i  f  i  er; 

register  char  *optional_actual_argument_list; 

< 

start_timer(  identifier  ); 

if  (  optional_actual_argument_list  !=  0  ) 

< 

print_level (  level  ); 

margin_print f (  "CALL  %s(%s)\n",  identifier,  list(  optional_actual  argument  list, 

",  "  )  )  ; 

} 

else 

i 

print_level (  level  ); 

margin_printf (  "CALL  %s()\n" ,  identifier  ); 

1 

stop_timer(  identifier  ) ; 

)  /*  call  statement  */ 


FILE:  ctimer/statement/close  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 

*/ 


extern  int  level; 
extern  char  *list(  ); 


void  close_ctatement (  control_list  ) 
register  char  *control_list; 

( 

print_level (  level  ) ; 

margin_printf (  "CLOSE  <%s)\n",  list!  cont rol _1 i st ,  "  )  )  ; 

)  /*  close  statement  */ 


FILE:  ctimer/statement/comment  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 

*/ 


void  comment_statement (  string  ) 
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register  char  'string; 

{ 

margin_print f  (  ’^s",  string  ); 
}  /'  comment_statement  '/ 


FILE:  ctimer/statement/common  statement. c 


/* 

*  Copyright  1991 

’  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  'parse (  ); 
extern  char  'list!  ); 


void  common_statement (  optional_common_nane,  common_list  ' 
register  char  *optional_common_name; 
register  char  *common_list; 

{ 

register  char  'common; 

register  char  'identifier; 

register  char  'optional_subscript_list; 

print_level (  level  ) ; 

margin_prir.t f '  -COMMON  "  ); 

if  (  optional_co.nmon  name  !=  0  ) 

margin_printf (  “7% s/  ",  optional_comm'.  _name  ); 

while  (  common  =  parse (  common_list  J  ) 

( 

identifier  =  parse (  common  ); 
optional_subscript_list  =  parse (  common  ); 

margin_printf (  “%s",  identifier  ); 
if  (  optional_subscript_list  !=  0  ) 

margin_printf (  "(%s)",  list(  optional_subscript_list, 

if  (  strlen(  commor._list  )  !=  0  ) 

margin_print f (  ",  "  ); 

) 

margin_printf (  "\n"  ); 

)  /*  common  statement  ’/ 


FILE :  ctimer/ statement /computed_go_to_statement . c 


/* 

*  Copyright  1991 

'  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

'/ 


extern  int  level; 
extern  char  'list(  ); 


void  computed_go_to_statement (  label_list,  expression  ) 

'egister  -La.  'label_list; 

.agister  char  'expression; 

( 

print_level (  level  )  ; 

margin_printf (  -GO  TO  (%s)  ,  %s\n",  list(  label_list,  ",  "  ), 
}  /*  computed_go_to_statement  */ 


FILE:  ct i me r/st a tement /cont i nue  statement. c 


)  )  ; 


expression  )  ; 
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*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

'/ 


extern  int  level; 


void  continue_statement (  ) 

{ 

print_level (  level  ) ; 
margin_printf (  "CONTINUEXn"  ); 
)  /*  continue  statement  */ 


FILE:  ctimer/statement/data  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

V 


extern  int  level; 
extern  char  'parse  (  ) ; 
extern  char  *list(  ); 


void  data_statement (  data_list  ) 
register  char  'data_list; 

< 

register  char  'data; 

register  char  'variable_list; 

register  char  *constant_list; 

print_level (  level  ) ; 

margin_printf  (  "DATA  "  ); 

while  (  data  -  parse!  aata_list  )  ) 

1 

variable_list  =  parse!  data  ); 

ccnstant~list  =  parse!  data  ); 

margin_printf (  "%s  /%s/",  list!  variable  list,  ",  "  ),  list!  constant_l i sc ,  ",  "  ) 
)  ;  . 

if  (  strlen!  data_list  )  !=  0  ) 

margin_print f (  ",  "  ); 

1 

margin_printf (  "\n"  ); 

)  /*  data  statement  '/ 


FILE:  ctimer/statement/declaration  statement. c 


/* 

'  Copyright  1991 

'  Georgia  Institute  of  Technology 
'  Computer  Engineering  Research  Laboratory 
*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  'parse!  ); 
extern  char  'list!  ); 


void  declaration_statement (  type,  declaration! i st  ) 

register  char  'type; 

register  char  'decl a  rat ion_l i st ; 

{ 

register  char  'declaration; 
register  char  'identifier; 
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register  char  'opt ional_s”^rcript_i i st ; 

print_ievel (  level  ) ; 
irargin_prinr  f  (  "%s  ",  type  ); 

while  (  declaration  =  parse',  declaration_list  )  ) 

1 

identifier  =  parset  declaration  ); 
optional_subscript_list  =  parset  declaration  ); 

margi n_orint f (  "%s",  identifier  ); 

if  (  ODtional _ subscript _ list  !=  0  ) 

margin_print f (  "(%s)",  list  (  opt ione»l_subscript_l i st , 

if  (  strlent  declaration_list  )  !=  0  ) 

margin_printf (  ",  "  ); 

; 

margin_print f (  "\n"  ); 

}  /'  declaration  statement  */ 


FILE:  ctimer/statement/dimension  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
'/ 


extern  int  level; 
extern  char  “parse (  ); 
extern  char  *list(  ); 


void  dimension_statement (  dimension_l ist  ) 
register  char  *dimension_list; 

register  char  'dimension; 
register  char  'identifier; 
registe  char  *subscript_list; 

print_level '  level  ) ; 
margin_printf (  "DIMENSION  "  ); 

while  (  dimension  =  parse!  dimension_l ist  )  ) 

( 

identifier  =  parse!  dimension  )  ; 
subscript_l i st  =  parse!  dimension  ); 

margin_print f (  "%s(%s)",  identifier,  list!  subscript_ L l st , 

if  !  strlen!  dimension_l ist  )  !=  0  ) 

margin_printf (  ",  "  ); 

) 

margin_printf (  "\n"  )  ; 

)  /*  dimension  statement  '/ 


FILE:  ctimer/statement/do  statement. c 


/* 

'  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  'list!  ); 


void  do_ statement (  label,  identifier,  expression  list  ) 
register  char  'label; 
register  char  'identifier; 
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register  char  ’expression  list; 
push_stack(  label  ); 
print_level(  level  ), 

margin_printf  (  "DO  %s  %s  ••  »s\n",  label,  identifier,  list  (  expression  list, 
leve 1  +  + ; 

)  /’do  statement  */ 


FILE:  ct imer / st atement /el se  if  statement. c 


/’ 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

’/ 


extern  int  level; 


void  el se_i f_statement (  expression  ) 
register  char  ’expression; 

( 

level--; 

print_levei (  level  ); 

margin_printf (  "ELSE  IF  < % s )  THEN\n",  expression  !; 
level++; 

}  /*  else  if  statement  ’/ 


FILE:  ctimer/statement/else  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 


extern  int  level; 


void  el se_statemenc  !  ) 

t 

1  tf  v  c  1  ~  ; 


print_level (  level  ) ; 
margin_print f (  ”ELSE\n"  ); 

leve 1 ++ ; 

}  /*  else  stattmenr,  */ 


FILE:  ct imer /statement /end  if  statement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
V 


extern  int  level; 


void  end_ i f_st atement (  ) 
leve 1 -- ; 


print_level{  level  ); 
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:.:argin_printf  !  "END  IF \n"  )  ; 

1  /’  end_i f_statement  */ 

FILE:  ct ime r/ statement / ena  statement,  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 

’/ 


extern  int  level; 


void  end_statement (  ) 
l 

print_level (  level  ) ; 
margin_printf (  "END\n”  )  ; 
)  /*  end  statement  ’/ 


FILE:  ct iwer /statement /endfile  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 

♦/ 


extern  int  level; 
extern  char  *list(  ); 


void  end*ile_statement  (  controi_iist  ) 
register  char  *control_list; 

( 

print_level (  level  ) ; 

margin_printf (  "ENDFILE  (%s)\n",  list!  cont rol_l i st ,  " 
)  /*  endfile  statement  */ 


FILE:  ctimer/ statement /ent ry_statement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 

*/ 


extern  int  level; 
extern  char  ’iist(  ); 


void  ent ry_statement (  identifier,  cpticnal_formai_argument 
register  char  ’identifier; 

register  char  ’optional  formal_argument  list; 

( 

if  (  opt ional_formai_argument_Iist  ! =  0  ) 

( 

print_Level(  level  ); 

margin_print f (  "ENTRY  *s(%s)\n”,  identifier,  list) 
",  "  )  )  ; 

1 

else 

( 

print _ level i  level  ); 

margin_print f (  “ENTRY  %s()\n",  identifier  ); 

> 

i  /*  en- t y_5La. e-ent  */ 


)  )  ; 


list  ) 


opticnai_formai_argument_i i st , 
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u  t  i  me  r  /  s  t  a  Lem  e  rL/'equiVdle  n  ce  •.  a  *.  *■  re  r.  *  . 


Copyright.  19  91 

Georgia  rnstiLulfi  of  Technology 
Computer  Engineering  Research,  laboratory 
Author:  Stephen  R.  Wachtei 

/ 


extern  ir«t  level; 
extern  char  *parse  (  ); 
extern  char  *list(  ); 


void  equivalence  statement (  equivalence  list  ) 
register  char  •equivalence  list; 

register  char  *variable_list; 

print_ievel {  level  ); 
margin_printf {  "EQUIVALENCE  "  ); 

while  \  va r i able_l i st  =  parse (  equi valence^! i st  )  ) 

ma  rgi  n_print  f  (  "(%s)",  list(  variable_I i sr ,  ”,  "  )  ); 

if  (  strlen(  equivalence_list  )  !*  0  ) 

margin_print f (  ",  "  ); 

) 

margir»_print  f  (  ”\n"  ); 
t  /*  equ iva ience__statem3nt  */ 


FILE:  ct imer/st atement /external  statement. c 


*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research,  Laboratory 

*  Author:  Stephen  R.  Wachtei 

*/ 


extern  int  level; 
extern  char  *list{  ); 


void  external  _stat.enent  (  externa  1  _1  i  st  ) 
register  char  'external  list; 

print  level {  level  ); 

ma rgi n_pr i nt f (  "EXTERNAL  %s\n",  list(  external! ist,  ",  "  )  ); 

*  /  *  external  statement  * ! 


FILE:  ct imer / statement / format  statement. c 


/  * 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laccratcry 

*  Author:  Stephen  R.  Wachtei 

*  / 


extern  int  level; 


void  format  statement  (  format.  } 
register  char  *  format; 

format ; 3 
format  :  1 
f o  rma  t  '  2 
format { 3 
format  [  4 


0}  ■Xi  U3 
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print  level (  level  ) ; 

margin  printf(  "  %  s  \  r. " ,  format  ); 

}  / *  format  statement  "/ 


c  1 1  me  r  /  s  t  a  t  erne r.  t  /  f  u  n  c  t  i  o  r.  star  erne  r 


"  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  laccratory 

*  Author:  Stephen  R .  Wachtei 


extern  mt  level; 
extern  char  *  1  i  s  t  (  ); 


void  f  ur.ct  ion_statement  {  opt  icn.al  _type/  identifier,  optional 
ister  char  *optional_type; 
ister  char  *  identifier; 

ister  char  *  opt i cna 1 _  forma  1 _a  rgumen  t  list; 

print  level (  level  ); 
if  (  opt i onal_type  !=  0  ) 

margi  n_pr i. nt  f  (  "%s  ",  opt  i cna l_type  ); 

if  (  opt.ior.ai_f  ormal_argumer.t__l  i  st  1  »  0  ) 

margiri_pr  int  f  \  "FUNCTION  %s(%s)\n",  identifier,  iist< 
opt ionai_fcrmal_argument_l ist,  ",  "  )  ); 

e  l  sc 

margi  rs_prmt  f  (  "FUNCTION  %s()\n",  identifier  ); 

*  t *  function  statement  */ 


FILE:  ct imer/ statement / imp 1 ici t_st a tement . c 


*  Copyright  1991 

*  Georgia  Institute  cf  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 

*  / 


extern  int  level; 
extern  char  *list(  ); 


void  impl  ici  t  ^statement  (  type,  imp* ici t_. ; st  ) 
register  char  ‘type; 
register  char  *  imp. icit_i i st ; 

print  level {  level  ); 

margin_prmt f (  "IMPLICIT  %s(%s)\n",  type,  i;s:  (  implicit 
}  /*  impl  ici  t  _statemer,t  */ 


E :  ct  i mer  /statement  /  induce  statement .  c 


*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 


extern 


1  eve  1  ; 


void  i  r.c  I  u  de  s  t  a  t  erne  r.  t  f  .  :  1  e  n  a  me 
register  char  ^filename; 

print_ Level (  leve'  ); 


.  Part  2 


forma,  arg.-’-er.t 
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margin_printf (  "INCLUDE  %s\n",  filename  ); 
t  /*  include_statement  */ 


FILE :  ctimer / st atement / inqui re_st atement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 


void  inquire_statement (  controi_list  ) 
register  char  *control_list; 

{ 

print_level (  level  ) ; 

margin_print f (  "INQUIRE  (%s)\n“,  list(  cont rol_l i st ,  ”,  "  )  ); 

}  /*  inquire_statement  */ 


FILE:  ct imer/ statement /int rinsic  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  *list(  ); 


void  intrinsic_statement (  intrinsicl ist  ) 
register  char  *intrinsic_list; 

( 

print_level (  level  )  ; 

margin_printf (  "INTRINSIC  %s\n",  list(  int rinsic_l i st ,  ",  "  )  ); 
)  /*  intrinsic  statement  */ 


FILE:  ctimer/statement/logical_if_statement .c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 


void  logical_i f_statement  (  ) 

( 

level--; 
label (  0  ) ; 

print_level (  level  ) ; 
marqin_printf (  "END  IF\n"  ) ; 
}  /*  logical_i f_statement  */ 


void  i f _express i on (  expression  ) 


{ 


.ster 

char  * 

expression; 

print 

_leve  1 

(  level  ) ; 

margi 

n_pr  i  n 

tf(  "IF  (»s 

level 

; 

label 

l  0  )  ; 

)  THEN\n",  express:: 


)  ; 
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)  /*  i f_expression  */ 

FILE:  ct imer/ st atement /namel ist  statement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  "list!  ); 


void  namelist_statement (  namel i st_name,  namelist  list  ) 
register  char  * namel ist_name; 
register  char  *namelist_list; 

{ 

print_level (  level  ) ; 

margin_printf (  "NAMELIST  /%s/  %s\n",  namel i st_name ,  list!  namelist 
}  /*  namelist  statement  "/ 


FILE :  ct imer/ st atement /open_st atement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  'list!  ); 


void  open_statement (  control_list  ) 
register  char  *control_list;~ 

( 

print_level (  level  ); 

margin_print f (  "OPEN  <%s)\n",  list!  control_l i st ,  ",  "  )  ); 
1  /*  open_statemenc  */ 


FILE:  ct  ime  r  /  st  a  temen  t /parameters  t  atement .  c 


/* 

*  Copyright  1991 

’  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  "parse!  ); 


void  parameter_statement (  parameter_list  ) 
register  char  *parameter_list; 

( 

register  char  "parameter; 
register  char  "identifier; 
register  char  "expression; 

print_level (  level  ) ; 
margin_printf (  "PARAMETER  (”  ); 

while  (  parameter  -  parse!  parameter_Ust  I  ) 

f 

identifier  =  parse!  parameter  ); 
expression  =  parse!  parameter  ); 

margin_pr i nt f (  "%s  =  %s",  identifier,  expression  ); 


list,  ",  "  )  ); 
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if 


(  strlenl  parameter_list 
margin_printf  (  ",  "  ); 


0  ) 


margin_printf (  ")\n"  ); 

)  /*  parameter_statement  */ 


FILE:  ctimer/statement/pause_statement .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wac'ntei 

*/ 


extern  int  level; 


void  pause_statement (  optional_expression  ) 
register  char  *optional_expression; 

( 

if  (  opt ional_expression  !=  0  ) 

( 

print_level (  level  ) ; 

margin_printf (  "PAUSE  %s\n",  optional_expression  ); 

1 

else 

( 

print_level (  level  ) ; 
margin_printf (  "PAUSEVn"  ); 

1 

(  /*  pause_statement  */ 


FILE:  ctimer/ st atement/print_statement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  *list(  ); 


void  print_statement (  control_list,  optional_io_l ist  ) 
register  char  *control_list; 
register  char  *optional_io_list; 
f 

if  (  optional_io_list  l-  0  ) 

( 

print_level (  level  ) ; 

margin_print f (  "PRINT  < % s )  %s\n",  list(  cont rol_l i st ,  ", 
optional_io_list,  ",  "  )  ); 

) 

else 

{ 

print_level(  level  ); 

margin_printf (  "PRINT  (%s)\n“,  list(  control_list,  ”,  "  ) 

} 

)  /*  print_statement  */ 


FILE:  ctimer/ statement /program_statement .c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


"  ) ,  list  ( 


) ; 
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extern  int  level; 


void  program_statement (  identifier  ) 
register  char  'identifier; 

( 

print_level (  level  ) ; 

margin_printf (  "PROGRAM  %s\n",  identifier  ); 
)  /*  program_statement  '/ 


FILE:  cti mer/statement/read  statement. c 


/' 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  "list  (  ) ; 


void  read_statement (  cont rol_li st ,  optional_io_list  ) 
register  char  'control_list; 
register  char  ’optional_io_list; 

< 

if  (  optional_io_list  !=  0  ) 

{ 

print_level (  level  ) ; 

margin_printf (  "READ  ( % s )  %s\n",  list(  cont rol_l i st ,  ", 
optional_io_list,  ",  "  )  ); 

1 

else 

( 

print_level (  level  )  ; 

margin  printft  "READ  (%s)\n",  listt  control_list,  ",  "  ) 

1 

)  /*  read  statement  '/ 


FILE:  ctimer/statement/return  statement. c 


/' 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 


void  return_statement (  expression  ) 
register  char  'expression; 

{ 

if  (  expression  !=  0  ) 

f 


print_level (  level  ) ; 

margin_printf (  "RETURN  %s\n",  expression  ); 

) 

else 

( 

print_level (  level  ) ; 
margin_print f (  "RETURNVn"  ); 

1 

)  /'  return  statement  */ 


FILE:  ct imer/ statement / rewind  statement. c 


/* 


) ,  list  ( 


)  ; 


Copyright  1991 
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*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  *list(  ); 


void  rewind_statement (  control_list  ) 
register  char  *control_list; 

( 

print_level (  level  ) ; 

margin_printf (  "REWIND  (%s)\n",  list(  cont rol_l i st ,  ",  "  )  ); 

I  /*  rewind  statement  */ 


FILE:  ctimer/statement/save  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

V 


extern  int  level; 
extern  char  *list(  ); 


void  save_statement  (  save_list  ) 
register  char  'save_list; 

( 

print_level (  level  )  ; 

margin_print f (  "SAVE  %s\n",  list(  save_list,  ",  "  )  ); 
i  /*  save  statement  */ 


FILE:  ct imer/ statement / st op_statement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
'/ 


extern  int  level; 


void  stop_statement (  optional_expression  ) 
register  char  *optional_expression; 

{ 

if  (  optional_expression  !=  0  ) 

( 

print_level (  level  ) ; 

margin_print f (  "STOP  %s\n",  optional  expression  ); 

1 

else 

{ 

print_level (  level  ) ; 
margin_print f (  "ST0P\n"  ); 

) 

}  /*  stop_statement  */ 


FILE:  ct imer /statement / subrout i ne  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*  / 
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extern  int  level; 
extern  char  "list!  ); 


void  subroutine  statement!  identifier,  optional_formal_argument_list  ) 
register  char  "Identifier; 

register  char  *optional_formal_argument_list; 

1 

if  (  optional_formal_argument_l i st  !=  0  ) 

1 

print_level (  level  ) ; 

margin_print f (  "SUBROUTINE  %s(%s)\n",  identifier,  list! 
optional_formal_argument_list,  ",  "  )  ); 

1 

else 

{ 

print_level (  level  ) ; 

margin_printf (  "SUBROUTINE  %s<)\n",  identifier  ); 

} 

)  /*  subroutine_statement  */ 


FILE :  ctimer /statement /uncond it ional_go_to_st at ement .c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 


void  unconditional_go_to_statement (  label  ) 
register  char  "label; 

( 

print_level(  level  ); 

margin_printf (  "GO  TO  %s\n",  label  ) ; 

)  /*  unconditional_go_to_statement  */ 


FILE:  ctimer/statement/write  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  ‘list!  ) ; 


void  write_statement (  control_list,  optional_io_list  ) 
register  char  *control_list; 
register  char  *optionaI_io_list; 
f 

if  (  optional_io_list  !=  0  ) 

( 

print_level  (  level  )  ,- 

margin_printf (  "WRITE  %s)  %s\n",  list!  cont rol_l i st , 
optional_io_list,  ",  "  )  ); 

1 

else 

{ 


print_level  (  level  )  ,- 

margin_printf (  "WRITE  (%s) \n",  list!  cont rol_li st ,  " 


t  /*  write  statement  */ 


list  ( 
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11.  Appendix  F:  declare  program  source 

FILE:  declare/Makef i le 


# 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


default:  declare 


CC  =  cc  -g 
INCLUDE  =  include 
CFLAGS  =  -IS (INCLUDE) 

LIBRARY  =  statement /statement . a  library /library . a 


OBJECTS  =  \ 

$( INCLUDE) /grammar . h  \ 
♦grammar. (co)  \ 
♦scanner. [coj  \ 
yy trace. [col  \ 
y. output 


PROGRAMS  =  \ 
♦declare 


grammar. c:  grammar. y 
yacc  -dv  grammar. y 
mv  y.tab.h  S  ( INCLUDE) /grammar . h 
mv  y.tab.c  grammar.c 


scanner. c:  scanner. 1 

lex  -vt  scanner. 1  I  sed  '  s/getc/yygetc/ ‘  >scanner.c 


scanner. o:  scanner. c  S (INCLUDE) /grammar. h 
$  (CC)  $ (CFLAGS)  -c  scanner. c 

grammar. o:  grammar.c 

S  (CC)  S (CFLAGS)  -c  grammar.c 

declare:  grammar. o  scanner. o  S (LIBRARY) 

S (CC)  -o  declare  grammar. o  scanner. o  S (LIBRARY) 


sgrammar. c : grammar . c  yytoken.awk 

awk  -f  yytoken.awk  <grammar.c  >sgrammar.c 

sgrammar. o: sgrammar. c 

$ (CC)  S (CFLAGS)  -c  sgrammar. c 

sdeclare:  sgrammar. o  scanner. o  $ (LIBRARY) 

S (CC)  -o  sdeclare  sgrammar. o  scanner. o  S (LIBRARY) 


dscanner.c:  scanner. c 

cp  scanner. c  dscanner.c 

dscanner.o: dscanner.c  S (INCLUDE) /grammar . h 
$(CC)  S (CFLAGS)  -DDEBU "  -c  dscanner.c 

ddeclare:  grammar. o  dscanner.o  S (LIBRARY) 

S (CC)  -o  ddeclare  grammar. o  dscanner.o  S (LIBRARY) 


tgrammar.c:  grammar.c 

sed  ' s/yystack : /s  yyt race (yystate)  ; / ‘  <grammar.c  >tgrammar.c 


tgrammar.o:  tgrammar.c 

S (CC)  $ (CFLAGS)  -c  tgrammar.c 
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tdeclare:  tgrammar.o  scanner. o  yytrace.o  S (LIBRARY) 

$(CC)  -o  tdeclare  tgrammar.o  scanner. o  yytrace.o  $(LIBRARY) 


yytrace.c:  grammar. c  yytrace.awk 

awk  -t  yytrace.awk  <y. output  >yytrace.c 

yytrace.o:  yytrace.c 

$(CC)  $  (CFLAGS)  -c  yytrace.c 


clean : 

cd  statement;  make  clean 
cd  library;  make  clean 
rm  -f  S  (PROGRAMS)  $  (OBJECTS) 


FILE:  declare/gramm.ar . y 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*  / 


/* 

*  FORTRAN  11 
*/ 


%token  RW_AND 
%token  RW_ASSIGN 
%token  RW_BACKSPACE 
*token  RW_BLOCK_DATA 
%token  RW_CALL 
%token  RW_CHARACTER 
»token  RW_CL0SE 
%token  RW_COMMON 
%token  RW_COMPLEX 
♦token  RW_CONTINUE 
%token  RW_DATA 
♦token  RW_DIMENSION 
%token  RW_DO 

%token  RW_DOUBLE_PRECISION 

%token  RW_ELSE 

%token  RW_ELSE_IF 

%token  RW_END 

%token  RW_END_IF 

%token  RW_ENDFILE 

*token  RW_ENTRY 

%token  RW_EQ 

%token  RW_EQU I VALENCE 

%token  RW_EQV 

♦token  RW_EXTERNAL 

%token  RW_FALSE 

*token  RW_FORMAT 

♦token  RW_FUNCTION 

♦token  RW_GE 

% token  RW_GO_TO 

% token  RW_GT 

%token  RW_IF 

%token  RW_IMPLICIT 

%token  RW_INCL(JDE 

ttoken  RW_INQUIRE 

%token  RW_INTEGER 

%token  RW_INTRINSTC 

»token  RW_LE 

♦token  RW_LOGrCAL 

♦token  RW_LT 

♦token  RW_NAMELIST 

♦token  RW_NE 

♦  token  P.W_NEQV 

♦token  RW_NOT 

♦token  RW_0PEN 

♦token  RW_OR 

♦token  RW_PARAMETER 

♦token  RW_PAUSE 

♦token  RW  PRINT 
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♦token  RW_PROGRAM 
♦token  RW_READ 
♦token  RW_REAL 
% token  RW_RETURN 
♦token  RW_REWIND 
%token  RW_SAVE 
%token  RW_STOP 
%token  RW_SUBROUTINE 
♦token  RW_THEN 
%token  RW_TO 
%token  RW_TRUE 
%token  RW_WRITE 
%token  RW  UNDEFINED 


%token  COMMENT 
♦token  CONCATENATE 
Itoken  D0U3LE_PRECISIGN 
Itoken  EXPONENTIATE 
%token  HOLLERITH 
%token  IDENTIFIER 
%token  INTEGER 
%token  LABEL 
%token  REAL 
%token  STRING 


%left  • , • 
knonassoc  ' : ' 

♦  ricrRt  '=' 

♦left  RW_EQV  RW_NEQV 
♦left  RW_OR 
♦left  RW_AND 
♦left  RW_NOT 

♦nonassoc  RW_EQ  RW_NE  RW_LT  RW_LE  RW_GT  RW_^£ 
♦left  CONCATENATE 
♦left  •  +  • 

♦left  ■/' 

♦right  EXPONENTIATE 
♦left  SIGN 


♦  { 

typedef  char  ‘POINTER; 
♦define  YYSTYPE  POINTER 

♦include  "list.h" 

♦include  "attribute. h" 

extern  POINTER  duplicate!  )  ; 
extern  POINTER  list!  ); 
extern  POINTER  merge!  ); 
extern  POINTER  type!  ); 

♦  > 


♦  ♦ 


program: 

optional_statement_list 

( 


summary (  ) ; 

} 


optional  statement_l ist : 
/*  NULL  */ 

I 

statement  list 


statement_l ist : 

statement 

I 

statement  list  statement 
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statement : 

comment_statement 

I 

label  unlabeled  statement 


comment_statement : 
COMMENT 


label : 

LABEL 


unlabeled_statement : 

inciude_statement 

I 

program_st atement 

I 

block_data_st atement 
i 

function  sta^ment 

I 

subroutine_st atement 

I 

entry _statement 

I 

end_st atement 

I 

speci f ication_st atement 
I 

executable_st atement 

I 

format  statement 


include_statement : 

RW  INCLUDE  character  constant 


program_statement : 

RW_PROGRAM  program_ident i f ier 

{ 

program_statement (  S2  ) ; 

) 


program_ident i f ier : 

IDENTIFIER 

f 

$$  =  SI; 

1 


block_data_statement : 

RW_BLOCK_DATA  block_data_ident i f ier 

{ 

block_data_statement (  $2  ) ; 

) 


block_data_identifier: 

IDENTIFIER 

( 

SS  =  SI; 

) 


function_statement : 

RW_FUNCTION  funct ion_ident i f ier  opt i ona i  f ormal 

< 

function_statement (  0,  $2,  S3  ); 


a  rgument_l i st 


!!.  Appendix  F:  declare  program  source 


113 


type  RW_F'JNCTICN  f urct  ior._ident  i  f  ier  opt  ional_formal_arguir.ent_i  i  st 
( 

function_statement (  SI,  $3,  $4  ); 

1 


function_identifier: 

IDENTIFIER 

{ 

SS  =  SI; 

) 


subroutine_statement : 

RW_SUBROUTINE  subrout ine_ident if ier 
I 

subroutine_statement  (  $2,  0  ); 

) 

I 

RW_SUBROUTINE  subroutine_ideoti f ier  opt ional_f ormal_argument  iist 

( 

subrout ine  statement (  S2,  S3  ); 

} 


subrout ine_identi fie r : 
IDENTIFIER 
f 

SS  =  SI; 


entry_statement : 

RW_ENTRY  entry_identifier 

I 

RVi_ENTRY  ent ry_ident i f ier  optional_forroai_argument_list 


entry_identif ier: 

IDENTIFIER 

( 

SS  =  SI; 

) 


optional_formal  argument  list: 

1 

SS  =  0; 

1 

I 

"  <  *  formal_argument_l ist  *)’ 

f 

SS  -  S2; 

1 


formal_argument_list : 

formal_argument 

( 

SS  =  merge  (  "(%s)’’,  SI  ); 

1 

I 

formal_argument_l i st  formal_argument 

{ 

SS  =  merge!  "%s(%s)",  SI,  S3  ); 

) 


f orma 1 _a  rgument : 

IDENTIFIER 
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{ 

SS  =  SI; 

) 

forma I_argument_al ternate 

( 

$$  =  SI; 

) 


formal_argument_al ternate_return : 

«  *  t 

I 

S$  =  duplicate!  "*“  ); 


end_statement : 

RW_END 

( 

end_statement (  )  ; 

) 


f ication_statement : 
external  statement 

int  rinsic_statement 

parameter_statement 

dimensionstatement 

declaration_statement 

save_statement 

common_statement 

equivalence_statement 

impiicit_statement 

data_statement 

namelist  statement 


exte  rna l_statement : 

RW  EXTERNAL  external  list 


external_list : 

external 

( 

$5  =  merge!  SI 

1 

I 

external_list  external 

i 

$S  =  merge!  "%s{%sf”, 

1 


external : 

IDENTIFIER 

{ 

S  S  =  SI; 

1 


speci 


I 


I 


I 


I 


intrinsic_ statement: 

RW  INTRINSIC  intrinsic  lis 


return 


)  ; 


SI,  S3  ); 
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int  r insic_l 1st : 

intrinsic 

{ 

$$  -  merge (  " {%s}”,  $1  }; 

1 

intrinsic_iist  intrinsic 

{ 

$$  =  merge  (  "  %  s  {  %  s }  " ,  $1,  $3  ); 

) 


intrinsic: 

ID^mt: 

$  $ 

} 


parameter_statement : 

RW_PARAMETER  •  C  parameter_l i st  ’)' 

( 

pa ramete r_statement (  $3  ) ; 

) 


pa  ramete r_i i st : 

pa  rameter 

i 

$$  *  merge (  M { % s  }  " ,  $1  ); 

1 

parameter_l  .i  st  ' ,  '  parameter 

i 

$$  =  merge (  "%s{%s}M,  $1,  $3  ); 

1 


parameter : 

IDENTIFIER  * expression 

$$  =  merge  (  "(%s}{%s}",  $1,  $3  ); 


d i  me n  s  i  o n _s  t  a  t  erne n t : 

RW_DIMENSION  ci mens  ion  list 

dimension  statement {  $2  ); 


d i men  s i on  list: 

d  imens i on 

{ 

S$  =  merge (  " { %  s / " ,  $1  ); 


dimer,sion_i  i  st  '  ,  '  dimension 

S$  -  merge  (  M%s{%s}'*,  $1,  3  3  ); 


dimen  s i on : 

IDENTIFIER  '('subscript  ist 
f 

$  3  =  me  rge  (  " «  %  s  »  •  %  s  •  " ,  31,  3  3  } ; 
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subscript_iist : 

subscript 

{ 

$$  =  merge  (  "  i%s;-",  51  ); 

i 

subscript_list  ' ,*  subscript 
{ 

$$  =  merge  {  "%s{%s!" ,  $1,  $3  ); 

) 


subscript : 

upper_bound 

S$  =  $1; 


1 owe rebound  1 : '  upper_bound 

{ 

$  $  *  me  rge  (  "  %  s :  %  s  ,  $  1 ,  $  3  )  ; 

} 


lower_bound: 

expression 

{ 

55  =  $1; 

} 


upper _bound: 

lower_bound 

( 

$$  =  SI  ; 


upper_bound_ad  just able 

$$  =  $1; 

} 


upper _bound_ad just able : 

«  «  • 

t 

$$  =  duplicate  (  " * "  ); 

) 


declarat ion 


type 

{ 


statement  : 
declaration  list 


declaration  statement  (  $1,  $2  ); 


declaration^!  ist: 

declaration 

{ 

$S  =  me rge (  " i%s>",  $1  ); 

) 


declaraticn_list  ' , '  declaration 

< 

S  v  =  merged  "  %  s  {  %  s  }  " ,  $  1 ,  $  3  )  ; 


de  c ! a  r a  t ion: 

$$  =  merge  {  "  %s;" ,  31  ); 
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IDENTIFIER  '('  subscript_i i st  ')' 

( 

SS  =  merge (  "(%s}!%siu ,  SI,  $3  ); 

1 


type: 

type_name  opt ional_type_length 

( 

$$  =  type (  $1,  S2  ) ; 

1 


type_name : 

RW_CHARACTER 

l 

$$  =  duplicate  i  "CHARACTER"  ); 

1 

I 

RW_COMPLEX 

( 

SS  =  duplicate (  "COMPLEX”  ); 

1 

I 

RW_DOUBLE_PRECISION 

SS  =  duplicate (  "DOUBLE_PRECISION"  ); 

1 

I 

RW_INTEGER 

( 

SS  =  duplicate (  "INTEGER"  ); 

1 

I 

RW_LOGICAL 

( 

SS  =  duolicate  (  "LOGICAL"  ); 

) 

I 

RW_REAL 

{ 

SS  =  duplicate  (  "REAL"  ); 

) 

I 

RW_UNDEFINED 

i 

SS  =  duplicate (  "UNDEFINED"  ); 

1 


optional  type_length: 
r*  NULL  */ 

( 

SS  *  0; 

} 

I 

type_length 

f 

SS  =  SI; 

) 


type_length : 

’*'  INTEGER 

{ 

SS  =  $2; 

) 

I 

'**  type_length_ad justable 

( 

SS  =  $2; 

i 


type_length_ad justable: 
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'  l . )  ’ 

{ 

$$  =  duplicate  (  "(*)"  ); 

1 


save_statement : 

RW_SAVE  opt ional_save_l i st 


optional  save_list: 
/"*  NULL  */ 

( 

SS  =  0; 


save_iist 

{ 

SS  -  SI; 

1 


save  list: 

save 

( 

SS  =  merge (  "(ts(" ,  SI  ); 

1 

save_list  save 

{ 

S $  =  me rge  (  " % s  {  % s )  " ,  $  1 ,  S3  )  ; 
I 


IDENTIFIER 

( 

SS  =  SI; 

1 

common^name 

< 

SS  =  SI; 

) 


common_statement : 

RW_COMMON  optional  common_name  common_variable_list 
( 

common_statement (  S2,  S3  ); 

1 


optional  common_name: 
r*  NULL  */ 
f 

SS  =  0; 

1 

I 

common_name 

( 

SS  =  SI; 

1 


save : 


I 


common_name : 

•/’  opt ional_ident i tier  ’/’ 
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/*  NULL  */ 

( 

$$  =  0; 

1 

IDENTIFIER 

( 

SS  =  SI; 

1 


common 


variable_list : 

’  common_variable 

{ 

$  S  =  me  rge  ( 

) 

common_variable 

( 

$3  =  merge ( 

) 


"{is)",  $1  )  ; 

lisc  common_vari able 

"%s(%s}'\  $1,  S3  )  ; 


common_variable : 

IDENTIFIER 

1 

SS  =  merge (  "{is)",  SI  >; 

1 


IDENTIFIER  * ( •  subscript_list  •)’ 

1 

SS  =  me  rge (  “!%sH%s)",  SI,  S3  ); 

1 


equivalence_statement : 

RW_EQUI VALENCE  equivalence  list 

{ 

equivalence  statement (  S2  ); 

1 


equivalence_list : 

equivalence 

{ 

$$  =  merge!  "{%s(",  SI  ); 

) 

equivalence_list  equivalence 

( 

SS  =  merge!  "  %  s  (  %  s )  " ,  SI,  S3  ); 

} 


equivalence : 

• ( •  equivalence_variable_list  * ) • 

{ 

SS  =  $2; 

1 


equivalence_variable_list : 

equi va lence_va  ri able 

( 

SS  =  merge!  " (%s)",  SI  ); 

) 

I 

equi valence_var iable_l i st  equi valencevariable 

( 

SS  =  merge!  "%s(%s)",  SI,  S3  ); 

) 


equ i va lence_va  r iable : 
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IDENTIFIER 

( 

$$  =  merge (  "(%s)",  $1  ); 

} 

I 

IDENTIFIER  •('  subscript_l i st  •)' 

{ 

$$  =  merge!  " ( %s ) ( %s ) " ,  SI,  $3  ); 

) 


implicit_statement : 

RW_IMPLICIT  type  •('  inr.plicit_list  ‘)‘ 

( 

impl icit_statement (  S2,  S4  ); 


implicit_list : 

implicit 

{ 

$$  =  merge!  ,,{%s)"/  SI  )  ; 

) 


implicit_list  implicit 

( 

$S  =  merge!  ,,%s(%s),\  $1,  S3  ); 

1 


implicit : 

IDENTIFIER 

! 

SS  =  merge!  "{is}",  SI  ); 

} 


IDENTIFIER  ■ -•  IDENTIFIER 

( 

SS  =  merge!  '•  |  %s)  {  %s)  •• ,  SI,  $3  ); 

1 


namelist_statement : 

RW  NAMELIST  namelist  name  namelist  list 


nameli st_name : 

■/’  IDENTIFIER  •/• 

1 

SS  =  $2; 

) 


namelist_list: 

namelist 

( 

SS  =  merge!  "(ts)",  $1  ); 

) 

I 

namel i st_l i st  namelist 

( 

SS  =  merge!  ”%s{%s)",  SI,  S3  ); 

) 


namelist : 

IDENTIFIER 

< 

SS  =  SI; 

) 


data  statement: 
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RW_DATA  data_list 

< 

data_statement (  $2  ) ; 

) 


data_list : 

data 

{ 

$$  =  merge(  "(is)",  SI  ); 

1 

data_list  optional_comma  data 

{ 

SS  =  merge!  "%s(%s}",  SI,  S3  ); 


data: 

data_variable  '/'  data_constant_list  '/' 

( 

SS  =  merge!  nf%s}(%s}",  SI,  S3  ); 

) 


data_variable: 

variable 

{ 

SS  =  SI; 

) 

I 

data_implied_do  list 

( 

SS  =  SI; 

1 


data_implied_do_list : 

'('  data_variable  IDENTIFIER  '='  expression_list  ')' 

( 

add_list(  0,  $4,  0,  0,  IMPLICIT  I  LOCAL  I  VARIABLE  ) ->number++ ; 
SS  =  $2; 
t 


data_constant_l i st : 

data_constant 

{ 

SS  =■  merge  (  "  (  %s}  ",  SI  )  ; 

) 

I 

data_constant_list  ' , '  data_constant 

( 

$$  =  merge!  "%s(%s}“,  SI,  S3  ); 

) 


data_constant : 

data_initialization 

( 

SS  =  SI; 

) 

I 

IDENTIFIER  data_initialization 

( 

SS  =  merge!  "%s  *  %s",  SI,  S3  ); 

) 

I 

INiEGER  data_initialization 

( 

SS  =  merge!  "%s  * 

) 


%s",  $1,  S3  ); 
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data_initialization: 

IDENTIFIER 

( 

SS  =  SI; 

1 

I 

character  constant 

( 

$$  =  SI; 

1 

I 

logical_constant 

{ 

SS  »  $1; 

} 

I 

signed_numerical_constant 

t 

SS  «  Si; 

1 


signed_numerical_constant : 

numerical_constant 

{ 

SS  =  SI; 

} 

I 

'  +  '  numfical_constant  %prec  SIGN 

( 

SS  =  merge (  "♦ts" ,  S2  ); 

) 

I 

numerical_constant  %prec  SIGN 

{ 

SS  =  merge (  "-%s",  S2  ) ; 

1 


expression: 

parenthesis_expression 

( 

SS  =  $1; 

1 

I 

simp!e_expression 

t 

SS  =  SI; 

) 


parenthesis_expression : 

■  ( '  expression  1 ) ' 

( 

SS  »  merge  (  "(  %s  S2  ); 

1 


simple_expression: 

variable 

( 

SS  =  SI; 

) 

I 

constant 

{ 

SS  =  SI; 

1 

I 

arithmet ic_expression 

( 

SS  =  SI; 

1 

I 

character _exp re ssion 

( 

SS  =  SI; 
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) 

relat ional_expression 

< 

$$  =  SI; 

) 

logical_expression 

( 

$$  =  SI; 

) 

unary_expression 

{ 

S$  =  Si; 

} 


variable; 

IDENTIFIER 

r 

add_list (  0,  SI,  0,  0,  IMPLICIT  I  LOCAL  I  VARIABLE  )->number++; 
SS  -  SI; 

1 

I 

IDENTIFIER  string_subset 

( 

add_list (  0,  $1,  0,  0,  IMPLICIT  I  LOCAL  I  VARIABLE  >->number++; 
$$  =  merge (  "%s%s",  SI,  S2  ); 

1 

array 

( 

SS  =■  SI; 

1 


array: 

IDENTIFIER  '('  aptional_expression_list  ')' 

( 

if  (  !array(  SI  )  ) 

( 

add_list (  0,  SI,  0,  0,  IMPLICIT  I  GLOBAL  I  VARIABLE  I  FUNCTION  )->number++; 

1 

else 

( 

add_list (  0,  SI,  0,  0,  IMPLICIT  I  LOCAL  I  VARIABLE  I  ARRAY  )->number++; 

1 

SS  =  merge)  "%s(  %s  )  ",  SI,  list)  $3,  ",  "  )  ); 

1 

I 

IDENTIFIER  '('  optional_expression_list  string_subset 

{ 

if  (  iarray)  SI  )  ) 

( 

add_list (  0,  SI,  0,  0,  IMPLICIT  I  GLOBAL  I  VARIABLE  I  FUNCTION  ) ->number++; 

} 

else 

1 

add_list (  0,  SI,  0,  0,  IMPLICIT  I  LOCAL  I  VARIABLE  I  ARRAY  )->number++; 

1 

SS  «  merge)  "%s<  %s  )%s",  SI,  list)  S3,  ",  "  ),  S5  ); 

} 


optional  expression_list : 
F*  NULL  */ 

{ 

SS  =  0; 

1 

I 

expression_l i st 

( 

SS  =  SI; 

} 
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expression_list : 

expression 

( 

$$  =  merge)  $1  ); 

} 

I 

expression_li st  expression 

{ 

$$  =  merge)  "%s{%s}",  $1,  $3  ); 

} 


string_subset : 

'('  optional_expression  optional_expression 

{ 

S$  =  merge)  " (  %s  :  %s  i ",  S2,  $4  ); 
i 


optional  expression: 
r*  NULL  */ 

{ 

SS  =  0; 

} 

I 

expression 

{ 

$$  -  $1; 

) 


constant : 

character_constant 

< 

$$  =  $1; 

) 

i 

logical_constant 

( 

S$  -  SI; 

) 

I 

numerical_constant 

{ 

SS  =  SI; 

1 


character_constant : 
HOLLERITH 
( 

SS  =  SI; 

1 

STRING 

( 

SS  =  SI; 

) 


logical_constant : 

RW_FALSE 

( 

SS  »  duplicate)  ".FALSE."  ); 

) 

I 

RW_TRUE 

( 

SS  -  duplicate)  ".TRUE."  ); 

) 


numerical_constant : 

„LUBLE_PRECISION 

{ 
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$$  =  $1; 

) 

I 

INTEGER 

{ 

SS  =  SI; 

) 

I 

REAL 

{ 

$$  =  SI; 

1 


arithmetic_expression : 

expression  '+’  expression  %prec  ' 

f 

SS  =  mergej  "  S  s  +  S  s  " ,  $1,  S3  i; 

1 

I 

expression  *-'  expression  %preo 

( 

SS  =  merges  "  S  s  -  S  s  " ,  SI,  S3  ); 

) 

I 

expression  expression  Spree 

( 

SS  =  merges  " %  s  *  %  s " ,  SI,  S3  ); 

1 

I 

expression  '/'  expression  %prec  ’/' 

{ 

SS  »  merges  "Ss/Ss",  $1,  S3  ); 

1 

I 

expression  EXPONENTIATE  expression  Spree  EXPONENTIATE 

{ 

SS  -  merges  "Ss«*Ss",  $1,  S3  ); 

) 


character_expression : 

expression  '/'  '/'  expression  %prec  CONCATENATE 

{ 

SS  =  merges  ”%s  //  %s",  SI,  S4  ); 

1 


relational_expression: 

expression  RW_EQ  expression  Spree  RW_EQ 

( 

SS  =  merges  "%s  .EQ.  %s",  SI,  S3  ) ; 

} 

I 

expression  RW  NE  expression  Spree  RW_NE 

< 

iS  =  merges  "Ss  .NE.  Ss",  SI,  S3  ); 

) 

I 

expression  RW_LT  expression  Spree  RW_LT 

{ 

$$  =  merge!  "Ss  .LT.  Ss",  SI,  S3  >; 

1 

I 

expression  RW_LE  expression  Spree  RW_LE 

( 

SS  -  merges  "Ss  .LE.  Ss",  SI,  S3  ); 

} 

I 

expression  RW_GT  expression  Spree  RW_GT 

( 

SS  =  merges  "Ss  .GT.  Ss",  SI,  S3  ); 

1 

I 

expression  RW_GE  expression  Spree  RW_GE 

f 

SS  =  merges  "Ss  .GE.  Ss",  SI,  S3  ); 

) 
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logical_expression: 

expression  RW_AND  expression  %prec  RW_AND 
1 

$$  =  merge (  "%s  .AND.  %s",  $1,  S3  ); 

> 

I 

expression  RW_OR  expression  %prec  RW_OR 

( 

$$  =  merge (  "%s  .OR.  %s",  SI,  S3  !; 

) 

I 

expression  RW_EQV  expression  %prec  RW_EQV 

f 

SS  =  merge (  "%s  . EQV.  %s",  SI,  S3  ); 

I 

1 

expression  RW_NEQV  expression  %prec  RW_NEQV 

{ 

SS  =■  merge  {  "%s  . NEQV.  %s”,  $1,  S3  )  ; 

1 


unary_expression : 

'+'  expression  %prec  SIGN 

( 

SS  =  merge (  "+%sn,  S2  )  ; 

1 

I 

1 -■  expression  %prec  SIGN 

( 

$$  -  merge (  ”-%s“,  S2  ); 

1 

I 

RW_NOT  expression  *prec  RW_NOT 

( 

SS  =  merge  (  ".NOT.  %s'\  $2  ); 

1 


executable_statement : 
do_statement 

I 

logical  i£_statement 
I 

bIock_i f_statement 
I 

else_statement 

I 

else_i f_statement 

I 

end_if_statement 

I 

subset  executable  statement 


do_statement : 

RW_DO  optional_integer  IDENTIFIER  '='  expression_l ist 

1 

do_statement (  S2,  S3,  S5  ); 

} 


optional  integer: 

r*  NULL  */ 
( 


INTEGER 

( 

SS  -  SI; 

1 
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logical_i f_statement : 

i f_expression  subset_executable_statement 


if_expression: 

RW_IF  ' ('  expression  ') ' 


block_i f_statement : 

RW_IF  ■('  expression  • >  *  RW_THEN 


ei se_statement : 

RW  ELSE 


eise_i f_statement : 

RW_ELSE_IF  '('  expression  •)'  RW_THEN 


end  if_statement : 

RW  END  IF 


subset_executable_statement : 

assignment_statement 

I 

assign_statement 

I 

arithmet ic_if_statement 

I 

continue_statement 

I 

call  statement 

I 

return_statement 

I 

uncondit ional_go_to_statement 

I 

computed_go_to_statement 

I 

assigned_go_to_st a tement 
I 

stop_statement 

I 

pause_statement 

I 

io  statement 


assignment_statement : 

variable  expression 


assign_statement : 

RW  ASSIGN  INTEGER  RW  TO  IDENTIFIER 


ari thmet ic_i f _st a tement : 

RW_IF  ' ('  expression  ') '  integer_list 


continue_statement : 

RW  CONTINUE 


cai l_st a tement : 

RW  CALL  IDENTIFIER 
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RW_CALL  IDENTIFIER  optiona’ _actual_argument_list 


optional_actual_argument_list : 

( 

$S  =  0; 

1 

I 

'('  actual_argument_list  ')' 

( 

$S  =  $2; 

1 


actual_argument_list : 

actual_arguir.ent 

( 

SS  -  merge (  "{ %s) ",  $1  ) ; 

1 

I 

actual_argument_list  actual_argument 

( 

$$  =  merge!  "%s(%s)M,  SI,  $3  ); 

1 


actual_argument : 

expression 

( 

$$  =  SI; 

) 

I 

actual_argument_alternate_return 

( 

SS  =  SI; 


actual_argument_alternate_return . 
•*'  INTEGER 
{ 

SS  =  merge!  ••*%s‘\  S2  ); 

1 


return_statement : 

RW_RETURN  optional_expression 


unconditional_go_to_statement : 
RW  GO  TO  INTEGER 


computed_go_to_statement : 

RW_GO_TO  '('  integer_Iist  ')'  optionai_comma  expression 


assigned_go_to_statement : 

Rw_GO_TO  IDENTIFIED 

I 

RW_GO_TO  IDENTIFIER  optionai_comma  '('  integerlist  ')' 


optional  comma: 

/*  NULL  */ 


integer_l i st : 
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INTEGER 

{ 

SS  =  merge!  SI  ); 

1 

integer_iist  INTEGER 

( 

$$  =  merge!  "%s(%s)",  SI,  S3  ); 

) 


pause_statement : 

RW_PAUSE  optional_expression 


stop_5tarement : 

RW_STOP  oprional_expression 

atement : 

open_st atement 

close_statemenr 

inqui re_st atement 

read_st atement 

write_statement 

print_statement 

backspace_statement 

rewind_st atement 

endfile  statement 


open_statement : 

RW_OPEN  '('  control  information  list  ’)’ 


cl ose_st atement : 

RW_CLOSE  '('  control  information  list  ’)' 


inquire_statement : 

RW_INQUIRE  '('  control  information  list  ')' 


io  st 


l 


read_statement : 

RW_READ  '('  control_information_list  ')'  optional_io_li st 

I 

RW_READ  control 

I 

RW_READ  control  io  list 


write_statement: 

RW  WRITE  * ('  cont rol_i n format i on_i i st  opt iona i_ic_i i st 


print_st atement : 

RW_PRINT  control 

i 

RW_PRINT  control  '  io  list 


backs pa ce_st atement : 

RW  BACKSPACE  '('  control  information  ;ist  ')' 
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RW  BACKSPACE  control 


rewind_statement : 

RW  REWIND  cont  rol_i  nf  ormat  ion_l  :  s:  *)' 

RW  REWIND  control 


endf ;  le_statement : 

RW_ENDFILE  ’  ('  cont  r  o  i_i  r.  f  ormat :  or.  I. s'.  ’  j  1 

RW  ENDEILE  control 


cont  rol_i  r.  format  i  on_l  1st: 

cont  roi_i n  format  ion 

( 

S$  «  merge (  SI  ); 

I 

I 

cont rol_i n format ion_I i st  cont roi_in format i on 

( 

$$  =  merge)  "%s(%sl",  SI,  $3  ); 

) 


cont roi_in format  ion : 
cont  rol 
( 

SS  =  SI; 

} 

I 

IDENTIFIER  expression 

{ 

S  $  =  me rge  (  " % s  =  % s " ,  Si,  S3  )  ; 

) 


control : 

variable 

t 

SS  = 

) 

constant 

1 

SS  « 

1 


f 

SS  = 

) 


optional  io_list: 

/*  NULL  */ 

( 

SS  -  0; 

) 

io_l ' st 

! 

SS  =  SI; 

) 


i o  list: 

i  o 
f 

SS  -  merge!  SI  ); 

) 


SI; 


SI; 


duplicate  (  ) ; 
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io_list  ' , 1  io 

{ 

SS  =  merge (  "%s{%s}",  SI,  $3  >; 

1 


expression 

{ 

SS  =  SI; 

1 

io_implied_do_list 

( 

SS  =  S_; 

1 


io_implied_do_list : 

'  <•'  io_list  IDENTIFIER  '  =  '  expression_list  •)' 

{ 

add_list (  0,  $4,  0,  0,  IMPLICIT  !  LOCAL  I  VARIABLE  ) ->number++ ; 

SS  =  merge  (  ”<  %s,  %s  =  %s  )  “,  list  (  S2,  ",  “  ),  S4,  iist(  $6,  ",  "  )  ); 

1 


format_statement : 

RW  FORMAT 


%% 

FILE:  declare /include/ at tribute . h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦define  IMPLICIT  0x0000 
♦define  EXPLICIT  0x0001 

♦define  LOCAL  0x0000 
#def ine  GLOBAL  0x0002 

# define  VARIABLE  0x0000 
# define  CONSTANT  0x0004 

((define  ARRAY  0x0010 
((define  COMMON  0x0020 

((define  FORMAL_ARGUMENT  0x0100 
((define  EQUIVALENCE  0x0200 

♦define  PROGRAM  0x1000 
♦define  FUNCTION  0x2000 


extern  char  'attribute  name (  ); 


FILE:  declare/include/list .h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Techno' ngy 

*  Computer  Engineering  Resear  v  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 
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((define  LIST  struct  list_type 
LIST 
{ 

char  ‘identifier; 
int  attribute; 
char  ‘type; 
char  *subscript_list; 
char  ‘data; 
int  number; 

LIST  ‘next; 


extern  LIST 
extern  LIST 
extern  LIST 
extern  LIST 
extern  void 
extern  LIST 


*end_list(  ); 
‘add_end_list ( 
* f ind_Ii st (  ) ; 
*add_li st  (  )  ; 
update_list  (  ) 
‘delete  list  ( 


)  ; 


FILE:  declare/include/option. h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦define  INITIALIZE  1 
extern  int  option; 

FILE:  declare/include/table . h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦  defir-:  TABLE  struct  table_type 
TABLE 
( 

char  ‘identifier; 
int  attribute; 

LIST  ‘list; 

>  ; 


extern  void  initialize_table (  ); 
extern  int  add_table(  T; 
extern  int  find  tablet  ); 


♦define  NUMBER_TABLE  250 

extern  TABLE  tablet  NUMBER_TABLE  ]; 

extern  int  number  table; 


FILE:  declare/1 ibrary/Makefi le 


♦ 

♦  Copyright  1991 

♦  Georgia  Institute  of  Technology 

♦  Computer  Engineering  Research  Laboratory 

♦  Author:  Stephen  R.  Wachtel 

♦ 


CC  -  cc  -g 

INCLUDE  =  . ./include 

CFLAGS  =  -IS (INCLUDE) 
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LIBRARY  =  library. a 


OBJECTS  =  \ 
array. o  \ 

att ribute_narae . o  \ 
count. o  \ 
duplicate. o  \ 
hollerith.o  \ 
implicit. o  \ 
implicit_data.o  \ 
link_list.o  \ 
list.o  \ 
ma i n . o  \ 
merge.o  \ 
non_blank.o  \ 
parse. o  \ 
split. o  \ 
summary. o  \ 
table. o  \ 
type.o  \ 
uppercase. o  \ 
yyerror.o  \ 
yygetc.o  \ 
yywrap.o 


5 (LIBRARY) : $ (OBJECTS) 

ar  crv  $ (LIBRARY)  S (OBJECTS) 
ranlib  S (LIBRARY) 


•SUFFIXES:  .c  .o 
.  c.  o : 

$(CC)  -c  S(CFLAGS)  $< 


clean : 

rm  -f  S (LIBRARY)  $ (OBJECTS) 
FILE:  declare/library/array. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


tinclude  <stdio.h> 
tinclude  "list.h" 
tinclude  "table. h" 
tinclude  "attribute. h" 


int  array(  identifier  ) 
register  char  'identifier; 

( 

register  LIST  'temporary  =  find_list(  table!  number_table  J.list,  identifier, 

return (  temporary  !=  (LIST  *)NULL  ); 

)  /*  array  */ 


FILE :  dec la re/ library /att ribute_name . c 


/' 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

'/ 


ARRAY  )  ; 


tinclude  <string.h> 
tinclude  "attribute. h 
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char  *attribute_name (  attribute  ) 
register  int  attribute; 

( 

static  char  name[  256  1; 
strcpyt  name,  ""  ); 

if  (  (  attribute  t  (  IMPLICIT  I  EXPLICIT  )  )  »=  EXPLICIT  ) 
strcat (  name,  "  EXPLICIT"  ); 

else 

strcat (  name,  "  IMPLICIT"  ); 

if  (  (  attribute  i  (  LOCAL  I  GLOBAL  )  )  ==  GLOBAL  ) 
strcat (  name,  ”  GLOBAL"  ) ; 

else 

strcat (  name,  "  LOCAL"  ); 

if  (  (  attribute  i  <  CONSTANT  1  VARIABLE  )  )  ==  CONSTANT  ) 
strcat (  name,  "  CONSTANT"  )  ; 

else 

strcat!  name,  "  VARIABLE"  >; 

if  (  (  attribute  i  ARRAY  )  ==  ARRAY  ) 
strcat (  name,  "  ARRAY”  )  ; 
if  (  (  attribute  &  COMMON  )  ==  COMMON  ) 
strcat  (  name,  "  COMMON"  )  ; 

if  (  (  attribute  &  FORMAL_ARGUMENT  )  ==  FORMAL_ARGUMENT  ) 
strcat!  name,  "  FORMAL_ARGUMENT"  ); 
if  (  (  attribute  &  EQUIVALENCE  )  ==  EQUIVALENCE  ) 
strcat!  name,  "  EQUIVALENCE"  ); 

if  (  {  attribute  S  PROGRAM  )  ==  PROGRAM  ) 
strcat!  name,  "  PROGRAM"  ); 
if  (  (  attribute  t  FUNCTION  )  ==  FUNCTION  ) 
strcat!  name,  "  FUNCTION"  ); 

return (  name  ) ; 

)  /*  attribute_name  */ 


FILE:  declare/library/count . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


int  count!  string,  length,  c  ) 
register  char  "string; 
register  int  length; 
register  char  c; 

1 

register  int  c  count  =  0; 

while  (  length  !=  0  ) 

( 

if  (  "string  ==  c  ) 
c_count++; 

string++; 

length — ; 

) 

return!  c_count  ); 

)  /*  count  */ 


FILE:  decla re /library /duplicate. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 
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♦include 

♦include 

♦include 


<stdio.h> 

<string.h> 

<malloc.h> 


char  'duplicate (  string  ) 
register  char  'string; 

{ 

register  char  'temporary  =  (char  *)NULL; 

if  (  string  !=  (char  *)NULL  ) 

( 

if  (  (  temporary  =  (char  *)malloc(  strlenf  string  )  +  1  )  )  !=  (char 

strcpy(  temporary,  string  ); 

else 

fprintf(  stderr,  "ERROR;  duplicate!  %s  ) \nB,  string  ); 

1 


return!  temporary  ); 
)  /*  duplicate  */ 


FILE:  declare/ library /holler ith. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 


char  'hollerith<  string,  delimeter  ) 
register  char  'string; 
register  char  delimeter; 

{ 

int  hollerith_length; 

register  int  string_length  =  0; 

sscanff  string,  "%dh",  shollerith_length  ); 

string!  string_length++  J  =  delimeter; 

while  (  hollerith_length  !=  0  ) 

( 

if  (  (  string [  string_length  ]  =  yyinput  !  )  )  ==  *\n'  ) 

( 

yyunput (  string!  string_length  J  ); 
break; 

} 

string_length++; 

hollerith_length--; 

1 

string!  string_length++  ]  =  delimeter; 

string!  string_length  ]  =  '\0'; 

return!  string  ); 

}  /*  hollerith  */ 


FILE:  declare/library/implicit . c 


/' 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  char  *default_integer; 
extern  char  'default_logical; 
extern  char  'duplicate)  ); 


* ) NULL  ) 
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static  char  *implicit_table [  ]  = 

( 

/*  A  */  0, 

/*  B  */  0, 

/*  C  */  0, 

/*  D  */  0, 

/»  E  */  0, 

/*  F  */  0, 

/»  G  */  0, 

/*  H  */  0, 

/*  I  */  0, 

/*  J  */  0, 

/*  K  */  0, 

/*  L  */  0, 

/*  M  */  0, 

/*  N  */  0, 

/*  O  */  0, 

/*  P  */  0, 

/*  Q  */  0, 

/*  R  */  0, 

/*  S  V  0, 

/*  T  */  0, 

/*  U  */  0, 

/*  V  */  0, 

/*  W  */  0, 

/*  X  */  0, 

/*  Y  */  0, 

/*  Z  */  0, 

/*  ?  */  "UNDEFINED" 


♦define  IMPLICIT_TABLE  (  sizeof(  implicit_table  )  /  sizeoft  char  *  )  ) 


int  offset (  c  ) 
register  char  »c; 

( 

♦define  LOWER_CASE (  c  )  (  (  c  >=  'a'  )  tt  (  c  <=  • z '  )  ) 

if  (  LOWER-CASE (  C [  0  )  )  ) 
return (  c[  o  ]  -  'a'  ); 

♦define  UPPERCASE  (  c  )  (  (  c  >=  1  A'  )  SS  (  c  <=  ■  Z  ■  )  ) 

if  (  UPPER— CASE (  c[  0  ]  )  ) 
return (  c[  0  1  -  'A'  ); 

return (  IMPLICIT_TABLE  -  1  )  ; 

)  /*  offset  */ 


char  »implicit_type (  string  ) 
register  char  "string; 

< 

return!  duplicate!  implicit_table [  offset!  string  )  )  )  ); 
)  /*  implicit_type  */ 


void  type_implicit (  string,  lower_bound,  upper_bound  ) 
register  char  "string; 
register  char  *lower_bound; 
register  char  *upper_bound; 

{ 

register  int  index; 

if  (  upper_bound  ™  0  ) 

upper_bound  =  lower_bound; 

for  (  indr-x  =  offset!  lower_bound  );  index  <=  offset!  upperjoound  );  index  +  +  ) 
implicit  table!  index  ]  =  string; 

)  /*  type_impliclt  */ 


void  implicit_initialize (  ) 

( 

type_impl icit (  "REAL* 4 " ,  "A",  "H"  ); 
type_impl icit (  default_integer,  "I",  “N"  ); 
type_implicit  (  "REALM",  "0",  "Z"  ); 

)  /*  implicit_initialize  */ 
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FILE:  declare/ library/implicit_dat a . c 


/* 

*  (~ooyr:  jbt  18Q1 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 
((include  "list.h" 
♦include  "attribute. h" 


extern  char  "duplicate  (  ); 
extern  char  "parse (  ) ; 


int  length_subscript_list (  subscript_list  ) 
register  char  *subscript_list; 

( 

register  char  "subscript; 
int  upper; 
int  lower; 

register  int  length  =  1; 

while  (  subscript  =  parse (  subscript_list  ) 

( 

if  (  sscanf (  subscript,  "%d:%d".  Supper, 

< 

upper  -  atoi (  subscript  ) ; 
lower  =1; 

> 

length  »«  (  upper  -  lower  +  1  ) ; 

} 

return (  length  ) ; 

)  /*  length_subscript_list  */ 


char  *data_value(  type  ) 
register  char  "type; 

{ 

int  length; 

if  (  sscanf (  type,  "CHARACTER* %d",  Slength  ) 
returnf  ); 

if  (  sscanf!  type,  "COMPLEX* %d”,  slength  )  = 

( 

switch  (  length  ) 

( 

case  8: 

return!  "  (0E0,  0E0)  "  ); 
case  16: 

return!  "(0D0,  0D0)"  ); 

) 


) 

if  (  sscanf!  type,  "INTEGER*%d",  Slength  ) 
( 

switch  (  length  ) 

( 

case  1: 

return!  "0"  ); 
case  2: 

return (  "0"  ) ; 
case  4: 

return!  "0"  ); 


) 


) 


if  (  sscanf!  type,  "LOGICAL*%d",  slength  ) 
! 


) 

Slower  )  !=  2  ) 


==  1  ) 

”  1  ) 


=  1  ) 
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switch  {  length  ) 

( 

case  1 : 

return!  ".FALSE." 
case  2: 

return!  ".FALSE." 
case  4: 

return!  “.FALSE." 


1 


1 


)  ; 


) ; 


if  (  sscanf (  type,  "REAL*%d",  Slength  )  ==  1  ) 

( 

switch  (  length  ) 

( 

case  4: 

return (  "0E0"  ) ; 
case  8: 

return!  "0D0"  ); 

( 

1 


fprintf!  stderr,  "ERROR:  data_value (  %s  )\n“,  type  ); 
exit <  -1  )  ; 

}  /*  data_value  */ 


char  *implicit_data (  entry  ) 
register  LIST  "entry; 

( 

static  char  data[  256  ]; 

if  (  (  entry->at tribute  i  ARRAY  )  —  ARRAY  ) 

sprintf!  data,  "td  *  %s",  length_subscript_list (  duplicate!  entry->subscript_list 
)  ),  data_value (  entry->type  )  ); 

else 

sprintf!  data,  "%s",  data_value(  entry->type  )  ); 

return (  data  )  ; 

)  /*  implicit_data  */ 


FILE:  declare/ library /link_list.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  <malloc,h> 
♦include  "list.h" 
♦include  "table. h" 
♦include  "attribute . h" 


extern  char  *implicit_type  (  ); 


♦define  ZERO!  a,  b)  (!a!=0)?a:b) 


LIST  *end_list(  list  ) 
register  LIST  "list; 

( 

if  (  list  ! =  (LIST  ♦ ) NULL  ) 

( 

while  (  list->next  !=  (LIST  *)NULL  ) 
list  =  list->next; 

1 


return (  list  ) ; 
)  /*  end  list  */ 
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LIST  *add_end_list (  list,  identifier  ) 
register  LIST  "list; 
register  char  'identifier; 

< 

register  LIST  'temporary  =  (LIST  *)malloc(  sizeof (  LIST  )  ); 

temporary->identif ier  =  identifier; 
temporary->type  =  (char  '(NULL; 
temporary->subscript_list  =  (char  '(NULL; 
temporary->data  =  (char  '(NULL; 
temporary->attribute  =  0; 
temporary->number  =  0; 
temporary->next  =  (LIST  '(NULL; 

<f  (  'list  ==  (LIST  * ) NULL  ) 

'list  =  temporary; 

else 

end_list (  'list  ) ->next  =  temporary; 

return!  temporary  ); 

)  /*  add_end_list  */ 


LIST  'find_list(  list,  identifier,  attribute  ) 
register  LIST  'list; 
register  char  'identifier; 
register  int  attribute; 

1 

register  LIST  'temporary; 

while  (  list  !=  (LIST  *)NULL  ) 

{ 

if  (  (  1 i st ->at tribute  &  COMMON  )  ==  COMMON  ) 

( 

if  (  (  temporary  =  find_list(  tablet  f ind_table (  list->identifier  )  (.list, 
identifier,  attribute  )  )  !=  (LIST  '(NULL  ) 

return (  temporary  ) ; 

> 

else 

l 

if  (  (  strcmp(  list->identifier,  identifier  )  ==  0  ) 
it  (  (  list->attribute  &  attribute  )  ==  attribute  )  ) 
return)  list  ); 

) 

list  =  list->next; 

) 


return (  (LIST  '(NULL  ); 
)  /*  find_list  */ 


LIST  *add_list(  structure,  identifier,  type,  subscript_list,  attribute  ) 

register  char  'structure; 

register  char  'identifier; 

register  char  'type; 

register  char  *subscript_list; 

register  int  attribute; 

( 

register  int  table_number; 
register  LIST  'temporary; 

if  (  structure  !=  (char  '(NULL  ) 

table_number  =  find_table(  structure  ); 
else 

table_number  =  nunnber_table; 

temporary  =  find_list(  tablet  table_number  (.list,  dentifier,  attribute  &  GLOBAL  ) ; 
if  (  temporary  ==  (LIST  '(NULL  ) 

temporary  =  add_end_list (  stable!  table_number  (.list,  identifier  ); 

if  (  (  attribute  S  (  IMPLICIT  I  EXPLICIT  )  )  =“  EXPLICIT  ) 
temporary->type  =  type; 

P  1  OP 

temporary->type  =  ZERO(  temporary->type,  impl ici t_type (  identifier  )  ); 

temporary->subscript_list  =  ZERO(  temporary->subscript_list,  subscript_l i st  ); 
temporary->attribute  1=  attribute; 
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return(  temporary  ); 
)  /*  add  list  */ 


void  update_list(  structure  ) 
reo*  ster  char  ‘striicturer 
( 

register  int  table_number; 
register  LIST  'list; 

if  (  structure  !=  (char  '(NULL  ) 

table_r>'imber  =  find_table (  structure  ); 
else 

table_number  =  number_table; 

list  =  tablet  table_number  J.lis*’; 
while  (  list  !=  (LIST  *)NULL  ) 

{ 

if  (  (  list->attribute  i  COMMON  )  COMMON  ) 
update_list (  list->identif ier  ); 
else 
{ 

if  (  (  list->at tribute  i  EXPLICIT  )  !=  EXPLICIT  ) 
list->type  =  implicit  type (  list->identifier  ); 

1 

list  =  list->next; 

) 

}  /*  update_list  */ 


LIST  *delete_list (  structure,  identifier  ) 
register  char  'structure; 
register  char  'identifier; 

( 

register  int  table_number; 
register  LIST  'last  =  (LIST  ' ) NULL; 
register  LIST  'curr; 

if  (  structure  !=  (char  *)NULL  ) 

table_number  ■  find_table(  structure  ); 

else 

table_number  *  number_table; 

curr  »  tablet  table_number  J.list; 
while  (  curr  !»  (LIST  '(NULL  ) 

( 

if  (  strcmpl  curr->identi f ier,  identifier  )  ==  0  ) 
{ 

if  (  last  —  (LIST  '(NULL  ) 

tablet  table_number  J.list  =  curr->next; 

else 

last->next  =  curr->next; 
break; 

> 

last  =  curr; 
curr  =  curr->next; 

1 

return!  curr  ); 

}  /'  delete  list  '/ 


FILE:  declare/library/list . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

'/ 


extern  char  'parse  (  ); 
extern  char  'merge (  ); 
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char  "list!  input_list,  delimeter  ) 
register  char  *input_list; 
register  char  "delimeter; 

( 

register  char  *output_list; 
register  char  "list; 
register  char  "temporary; 

output_list  =  parse (  input_list  ); 
list  =  parse (  input_list  ); 

while  (  list  !=  (char  »)0  ) 

{ 

temporary  =  merge (  "'s%s%s",  output_list,  delimeter,  list  ); 

free(  output_list  ); 
free (  list  )  ; 

output_list  =  temporary; 
list  =  parse!  input_list  ); 

1 


return!  output_list  ); 
)  /*  list  */ 


FILE:  declare/library/main.c 


/* 

*  Copyright  1991 

*  Gc3-Cfa  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  ft.  Wachtel 

*/ 


((include  <stdio.h> 
((include  <string.h> 
♦include  "option. h" 


extern  FILE  "yyin; 
extern  FILE  "yyout; 
extern  char  "def ault_integer; 
extern  char  *default~logical; 


int  option  =  0; 


♦define  PROGRAM  argument!  0  1 
♦define  INPUT_FILE  argument!  1  1 
♦define  OUTPUT_FILE  argument!  2  ! 


int  main!  number_argument,  argument  ) 
int  number_argument; 
char  "argument (  ] ; 

{ 

loop: 

if  (  strcmp!  argument!  number_argu-'ent  -  1  ],  "-size=2"  )  ==  0  ) 

( 

number_argument  —  ; 
def ault_integer  =  "INTEGER'2”; 
default_logical  =  "LOGICAL*2"; 
goto  loop; 

) 

if  (  strcmp!  argument!  number_argument  -  1  !,  "-size=4"  )  ==  0  ) 

( 

number_argument-- ; 
def ault_integer  =  "INTEGER*^"; 
defauit_logical  =  "LOGICAL* V; 
goto  loop; 

) 

if  (  strcmp!  argument!  number_argument  -  1  ],  "-ini t ial i ze=y "  )  ==  0  ) 

( 

number_argument--; 
option  1=  INITIALIZE; 
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goto  loop; 

) 

if  (  strcmp(  argument!  number_argument  -  1  ],  "-initializer"  )  ==  0 

{ 

number_argument — ; 

Oj,Lion  i  "l..x i 

goto  loop; 

) 


implicit_initialize (  ); 
initialize_table (  ); 

if  (  number_argument  ==  1  ) 

1 

yyin  =  stdin; 
yyout  =  stdout; 


yyparse (  ) ; 
exit  (  0  ) ; 

} 

if  (  number_argument  ==  3  ) 

( 

if  (  (  yyin  =  fopen (  INPUT_FILE,  "r"  )  ) 

( 

fprintft  stderr,  "%s:  ERROR  -  unable 
INPUT_FILE  ) ; 

exit (  -1  ) ; 

1 

if  (  (  yyout  =  f open (  OUTPUT_FILE,  "w"  ) 
( 

fprintft  stderr,  "%s:  ERROR  -  unable 
OUTPUT_FILE  ) ; 

exit<  -1  ); 

1 


««  (FILE  * ) NULL  ) 
to  open  input  file  ' %s'\ 


)  =«  (FILE  * ) NULL  ) 
to  open  output  file  '%s' 


yyparse  (  ); 
exit (  0  ) ; 

1 

iprintfl  staerr,  "usage:  %s  rinput  file>  <output  file>  [-size=2  or  4 
initialize=y  or  nl\n",  PROGRAM  ); 

exit  (  0  ) ; 

)  /»  main  */ 


FILE:  declare/ library/merge . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  <malloc.h> 


♦define  STRLEN (  s  )  (  strlenl  s  )  -  2  ) 


char  “merge!  string,  a,  b,  c,  d  ) 

register  char  “string; 

register  char  “a; 

register  char  “b; 

register  char  “c; 

register  char  *d; 

1 

register  char  “temporary  =  (char  “1NULL; 

switch  (  count!  string,  strlenl  string  ),  !  ) 

( 

case  Q: 

if  (  (  temporary  =■  (char  *)malloc(  strlenl  string  )  +  1  )  ) 

sprintfl  temporary,  string  ); 


PROGRAM, 


\ n " ,  PROGRAM, 


)  or  [- 


=  (char  * ) NULL  ) 
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else 

fprintfl  stderr,  "ERROR:  merge!  %s  )  \n",  string  ); 
break; 

case  1: 

if  (  (  temporary  =  (char  'Imallocl  strlenl  string  )  +  STRLEN  (  a  )  --  1  )  i  :  = 

(char  * ) NULL  ) 

sprintf(  temporary,  string,  a  ); 

else 

fprintf(  stderr,  "ERROR:  merge (  %s,  %s  )\n",  string,  a  ); 
break; 

case  2: 

if  (  (  temporary  =  (char  *)malloc(  strlenl  string  )  +  STRLEN (  a  )  +  STRLEN (  b 

)+!))!=  (char  *)NULL  ) 

sprintf(  temporary,  string,  a,  b  ); 

else 

fprintfl  stderr,  “ERROR:  merge!  %s,  %s,  %s  )\n",  string,  a,  b  ); 
break; 

case  3: 

if  (  (  temporary  =  (char  ')malloc(  strlenl  string  )  +  STRLEN  (  a  )  i-  STRLEN  (  b 

)  +  STRLEN  (  c  )  +  1  )  )  !=  (char  *)NULL  ) 

sprintf(  temporary,  string,  a,  b,  c  ); 

else 

fprintfl  stderr,  "ERROR:  merge!  %s,  *s,  %s,  %s  )\n”,  string,  a,  b,  c  ); 
break; 

case  4: 

if  (  (  temporary  =  (char  'Imallocl  strlenl  string  )  +  STRLEN (  a  )  +  STRLEN!  b 
)  +  STRLEN!  c  )  +  STRLEN!  d  )  '  1  )  )  !=  (char  '1NULL  ) 
sprintf(  temporary,  string,  a,  b,  c,  d  ); 

else 

fprintfl  stderr,  "ERROR:  merge(  %s,  %s,  %s,  %s,  %s  )\n",  string,  a,  b,  c,  d 

)  ; 

break; 
default : 

fprintfl  stderr,  "ERROR:  merge!  %s  ) \n",  string  ); 
break; 

1 

return!  temporary  ); 

)  /*  merge  */ 


FILE :  declare/ 1 ibrary /nonjalank . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 

*/ 


♦include  <string.h> 


char  *non_blank(  string  ) 
register  char  'string; 

( 

register  int  offset; 
register  int  length; 

length  =  strlenl  string  )  -  1; 

while  (  (  string!  length  )=='•)  Si  (  string!  length  ]  !=  '\0'  )  ) 
string!  length —  1  =  '\0'; 

offset  ~  0; 

while  (  (  string!  offset  ]=='•)  ss  (  string!  offset  1  (=  'VO'  )  ) 
string!  offset"  ]  =  '\0'; 

strcpyl  string,  Sstring!  offset  ]  ); 

if  (  strlenl  string  )  !=  0  ) 

return (  string  ) ; 

else 

return (  0  ) ; 

)  /*  non  blank  '/ 
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FILE:  declare/1 ibrary /parse . c 


/' 

'  Copyright  1931 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

'/ 


#include  <string.h> 


extern  char  'duplicate!  ); 


char  'parse!  list  ) 
register  char  'list; 

{ 

register  int  length  =  0; 

register  int  brace  =  0; 

register  char  'temporary  =  (char  *)0; 

for  ( ; ; ) 

( 

switch  (  list[  length  1  ) 

t 

case  1 { ' : 

brace++; 

break; 

case  •  )  '  : 

brace--; 

break; 

1 

if  (  brace  ==  0  ) 
break; 

length"; 

1 

if  (  length  !=  0  ) 

( 

listf  length  1  =  ' \ 0  •  ; 

temporary  =  duplicate!  list  +  1  ); 

strcpy!  list,  list  +  1  +  length  ); 

1 

else 

( 

if  (  list(  length  )  !=  '\0'  ) 

f 

temporary  «  duplicate!  list  ); 
list[  length  )  =  '\0'; 

) 

) 

return!  temporary  ); 

}  /*  parse  */ 


FILE:  declare/ 1 ibrary /spl it .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


char  'split!  string,  number,  delimeter  ) 
register  char  'string; 
register  int  number; 
register  char  delimeter; 

( 


register  int  count 


0; 
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register  char  *c; 

c  =  string; 

while  (  *c  !=  '\0'  ) 

< 

if  (  *c  ==  delimeter  ) 
count++; 

C+  +  ; 

) 


count  /=  number; 

c  =  string; 

while  (  *c  !=  '\0‘  ) 

{ 

if  (  *c  ==  delimeter  ) 

I 

if  (  — count  ==  0  ) 
break; 

) 

C++; 

} 

*c  =  'Non¬ 
return  (  ++c  ) ; 

)  /*  split  */ 


FILE:  declare/library/summary .c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


#include 

♦include 

♦include 

♦include 

♦include 

♦include 


<stdio.h> 
<string.h> 
"list . h" 
"table. h“ 
"attribute .  h" 
"option . h" 


exte  rn 

FILE 

*yyin; 

extern 

FILE 

•yyout; 

extern 

char 

•duplicate  I  )  ; 

extern 

char 

*implicit_data ( 

extern 

char 

'list  I  ) ; 

extern 

char 

'split!  )  ; 

)  ; 


void  output_subprogram_statement (  file,  identifier,  attribute  ) 
register  FILE  'file; 
register  char  'identifier; 
register  int  attribute; 

( 

if  (  (  attribute  i  PROGRAM  )  ==  PROGRAM  ) 

{ 

if  (  (  attribute  &  CONSTANT  )  ==  CONSTANT  ) 

fprintfl  file,  "XtPROGRAM  %s\n",  identifier  ) ; 

else 

fprintfl  file,  "\tBLOCK  DATA  %s\n",  identifier  ); 

! 

if  (  (  attribute  &  FUNCTION  )  ==  FUNCTION  ) 

( 

if  (  (  attribute  S.  CONSTANT  )  ==  CONSTANT  ) 

fprintfl  file,  "XtSUBROUTINE  %s()\n",  identifier  ); 

else 

fprintfl  file,  "\tFUNCTION  %s()\n",  identifier  ); 

) 

(  /'  output_subprogram_statement  '/ 


void  output_end_statement I  file  ) 
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register  FILE  "file; 

{ 

f print f (  file,  " \tEND\n"  ); 
)  /*  output_end_statement  */ 


void  output_declaration_statement (  file,  entry  ) 
register  FILE  "file; 
register  LIST  "entry; 

{ 

if  (  (  entry->attribute  S  (  LOCAL  I  GLOBAL  )  )  ==  LOCAL  ) 

( 

fprintf (  file,  “\t%s  %s",  entry->type,  entry->identifier  ); 

if  (  entry->subscript_List  !=  (char  »)NULL  ) 

fprintf (  file,  "(is)",  list(  duplicate (  entry->subscript_list  ),  ",  "  )  ); 

fprintf (  file,  ”\n"  ); 

if  (  (  (  entry->attribute  )  &  (  VARIABLE  I  CONSTANT  )  )  —  CONSTANT  ) 

fprintf (  file,  "\tPARAMETER  (%s  =  %s)\n",  entry->identifier,  entry->data  ) ; 

) 

}  /*  output_declaration_statement  */ 


void  output_common_statement (  file,  identifier  ) 
register  FILE  "file; 
register  char  "identifier; 

{ 

register  LIST  "list; 
register  char  delimeter; 

fprintf (  file,  "\tCOMMON  /%s/",  identifier  >; 
delimeter  =  ■  '; 

list  =  tablet  find_table(  identifier  )  J.list; 
while  (  list  !-  (LIST  »)NULL  ) 

( 

fprintf (  file,  "%c%s",  de*-’meter,  list->identifier  ); 
delimeter  =  ' , ' ; 

list  «  list->next; 

} 

fprintf (  file,  "\n"  ); 

list  =  tablet  find_table(  identifier  )  J.list; 
while  (  list  !=  (LIST  *)NULL  ) 
f 

output_declarat ion_statement (  file,  list  ); 
list  =  list->next; 

) 

)  /*  output_common_statement  */ 


void  output_data_statement (  file,  entry  ) 
register  FILE  "file; 
register  LIST  "entry; 

( 

register  int  lower; 
register  int  upper; 
register  char  "temporary; 

if  (  (  entry->at tribute  s  EQUIVALENCE  )  ==  EQUIVALENCE  ) 

fprintf (  file,  "*  EQUIVALENCE\n"  ); 

if  (  entry->data  !=  (char  "JNULL  ) 

( 

if  (  count (  entry->data,  strlenl  entry->data  ),  )  <=  100  ) 

fprintf  (  file,  "\tDATA  %s  /%s/\n",  ent ry->ident i f ier ,  entry->data  ); 

else 

( 

temporary  =  split (  entry->data,  2,  ); 

lower  =  1 ; 

upper  =  lower  +  count!  entry->data,  strlenf  entry->data  ),  ); 

fprintf (  file,  "\tDATA  (  %s(i),  i=%d,  %d  )  /%s/\n",  ent ry-> ident i f ier ,  iowe 
upper,  entry->data  ); 


lower  =  upper  +  1 ; 
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upper  =  lower  +  count (  temporary,  strlen(  temporary  ),  ); 

fprintfl  file,  "NtDATA  (  %s(i),  i=%d,  %d  )  /%s/\n",  ent ry-> ident i f ier ,  lower, 
upper,  temporary  ) ; 

1 


else 

fprintfl  file,  "\tDATA  %s  /%s/\n",  entry->identi f ier,  implicit_data (  entry  )  ); 
}  /*  output_data_statement  */ 


void  output_block_data_statement (  file  ) 
register  FILE  'file; 

I 

register  int  table_number; 
register  LIST  ‘list; 

output_subprogram_statement (  file,  "BLKDAT“,  IMPLICIT  |  GLOBAL  I  VARIABLE  !  PROGRAM  ); 

for  I  table_number  =  0;  table_number  !=  NUMB£R_TABLE;  table_number++  ) 

{ 

if  !  tablet  table_number  ). identifier  ==*  (char  ’(NULL  ) 
break; 

if  (  (  tablet  table_number  ]. attribute  &  COMMON  )  ==  COMMON  ) 

1 

fprintfl  file,  "*  COMMON  /%s/  DECLARATIONS" ,  tablet  table  number  ]. identifier 

)  ; 


output_common_statement (  file,  tablet  table_number  ]. identifier  ) ; 

} 

} 

for  I  table_number  =  0;  table_number  !=  NUM3ER_TABLE;  table  number++  ) 

{ 

if  (  tablet  table_number  ]. identifier  =«  (char  *)NULL  ) 
break; 

if  (  (  tablet  table_number  ]. attribute  i  COMMON  )  ==  COMMON  ) 

{ 

fprintfl  file,  COMMON  /%s/  INITIALIZATIONS",  tablet  table_number 
1  .  identifier  )  ; 

list  =  tablet  table_number  l.list; 
while  I  list  !«  (LIST  *)NULL  ) 

{ 

output_data_statement (  file,  list  ); 
list  =  list->next; 

) 


) 


) 


output_end_statement (  file  ); 
i  /*  output_block_data_statement  */ 


void  summary!  ) 

I 

register  int  table_number; 
register  LIST  "list; 
register  int  count; 

for  (  table_number  =  0;  table_number  !=  NUMBER_TABLE;  table  number++  ) 

I 

if  I  tablet  table_number  ]. identifier  ==  (char  *)NULL  ) 
break; 

if  (  (  tablet  table_number  (.attribute  &  COMMON  )  COMMON  ) 

( 

output_subprogram_statement (  yyout,  tablet  table_number  (.identifier,  tablet 
table_number  (.attribute  ) ; 

count  =  0; 

list  «  tablet  table_number  (.list; 
while  (  list  !=  (LIST  "(NULL  ) 

( 

if  (  (  (  list->attribute  S  COMMON  )  !=  COMMON  ) 

4S  (  (  li st ->at tribute  S  FORMAL_ARGUMENT  )  ==  r ORMAL_ARGUMENT  )  ) 

f 
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#ifndef 

tendif 


#i f ndef 
iendi  f 


# i fndef 


if  (  ++count  ==  1  ) 

fprintf (  yyout,  "*  FORMAL  ARGUMENT  DECLARATION\n"  ); 
output_declaration_statement (  yyout,  list  ); 

1 

list  =  list->next; 

) 

list  =  tablet  table_number  l.list; 
while  (  list  !=  (LIST  *)NULL  ) 
f 

if  (  (  list->attribute  4  COMMON  )  ==  COMMON  ) 

< 

fprintf (  yyout,  "*  COMMON  /%s/  DECLARATIONS",  list->identi f ier  ); 
output_common_statement (  yyout,  list->identif ier  ); 

} 

list  =  list->next; 

) 

count  =  0; 

list  »  tablet  table_number  l.list; 
while  (  list  !«  (LIST  *)NULL  ) 

( 

DEBUG 

if  (  list->number  !=  0  ) 

if  (  (  (  1 i st ->at tribute  4  COMMON  )  !=  COMMON  ) 

44  (  (  list->attribute  4  FORMAL_ARGUMENT  )  ! =  FORMAL_ARGUMENT  )  ) 

1 

if  (  ++count  ==  1  ) 

fprintf!  yyout,  "*  VARIABLE  DECLARATION\n"  ); 
output_declaration_statement (  yyout,  list  ); 

1 

list  =  list->next; 

1 


if 

{ 


DEBUG 


(  (  option  &  INITIALIZE  )  ==  INITIALIZE  ) 
count  =  0; 

list  »  tablet  table_number  l.list; 
while  (  list  !=  (LIST  *)NULL  ) 

{ 

if  (  (  (  list->attribute  t  COMMON  )  !=  COMMON  ) 

SS  (  (  li st ->at tribute  i  FUNCTION  )  !=  FUNCTION  ) 

55  (  (  list->at tribute  i  CONSTANT  )  !=  CONSTANT  ) 

56  (  (  list->attribute  S  FORMAL_ARGUMENT  )  !-  FORMAL  ARGUMENT  )  ) 

( 

if  (  list->number  !=  0  ) 


if  (  list->data  !=  (char  *)NULL  ) 

{ 

if  (  ++count  ==  1  ) 

fprintf!  yyout,  "*  INITIALIZED  DATA\n"  ) ; 


output_data_statement (  yyout,  list  ) ; 


list  »  list->next; 


if  (  (  option  i  INITIALIZE  )  ==  INITIALIZE  ) 


( 


count  -  0; 
list  =  tablet 
while  (  list 
( 


table  number  l.list; 


(LIST  * ! NULL  ) 


if 

t  i 
ii 
4  4 

( 


(  (  (  list->attribute  4 

(  (  list->attribute  4 

(  (  list->attribute  4 

(  (  list->attribute  4 


COMMON  ) 
FUNCTION 
CONSTANT 


! =  COMMON  ) 

)  ! =  FUNCTION 

)  :=  CONSTANT 


FORMAL  ARGUMENT  )  ! =  FORMAL  ARGUMENT  ) 


DEBUG 


if  (  list->number  !=  0  ) 
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#endi f 


) 

list 


if  (  list->data  ==  (char  *)NULL  ) 

( 

if  (  ++count  ==  1  ) 

f print f  (  yyout,  "*  UNINITIALIZED  DATA\n"  ); 
output_data_statement  (  yyout,  list  ); 

1 


list->next; 


output_end_statement (  yyout  ) ; 

} 

1 

if  (  (  option  t  INITIALIZE  )  ==  INITIALIZE  ) 
output_bloc)c_data_statement  (  yyout  )  ; 

)  /’  summary  */ 


FILE:  declare/library/table. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 
((include  <string.h> 
((include  "list.h" 
((include  "table. h” 
♦include  "attribute. h" 


int  number_table  =  0; 

TABLE  table [  NUMBERJTABLE  ]; 


void  initialize_table (  ) 

( 

register  int  table_number; 

for  (  table_number  =  0;  table_number  !=  NUMBER_TABLE;  table  number++  ) 
{ 

tablet  table_number  ]. identifier  =  (char  *)NULL; 
tablet  table_number  [.attribute  =  0; 
tablet  table_number  j.list  =  (LIST  *)NULL; 

1 

)  /*  initialize  table  */ 


int  add_table (  identifier,  attribute  ) 
register  char  ‘identifier; 
register  int  attribute; 

( 

register  int  table_number; 

for  (  table_number  =  0;  table_number  !=  NUMBER  TABLE;  table_number++  ) 
( 

if  (  tablet  table_number  J. identifier  ==  (char  *)NULL  ) 

( 

tablet  table_number  ]. identifier  =  identifier; 
tablet  table_number  j.attribte  =  attribute; 
tablet  table_number  j.list  =  (LIST  *)NULL; 

return (  table_number  ); 

) 

t 

fprintf (  stderr,  "ERROR:  add_table(  %s  )\n",  identifier  ); 
exit  (  -1  ) ; 

)  /*  add  table  */ 
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int  find_table(  identifier  ) 
register  char  ‘identifier; 

{ 

register  int  table_number; 

for  (  table_number  =  0;  table_number  !=  NUMB£R_TABLE;  table_number++  ) 

{ 

if  (  tablet  table  number  ). identifier  ==  (char  ‘(NULL  ) 
break; 

if  (  strcmp(  identifier,  tablet  table_number  ]. identifier  )  ==  0  ) 
return!  table  number  ); 

) 

return)  -1  ); 
i  /*  find_table  »/ 


FILE:  declare/library/type . c 


/* 

»  Copyright  1991 

*  Georgia  Institute  of  Technology 

»  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <string.h> 


extern  char  ‘duplicate!  ); 
extern  char  ‘merge!  ); 


char  *default_integer  =  "INTEGER‘4"; 
char  ‘default_logical  =  "LOGICAL*4"; 


char  ‘type!  type_name,  type_length  ) 
register  char  *type_name; 
register  char  *type~length; 

( 


if  (  type_Iength  !=  (char  * ) 0  ) 

return!  merge!  "%s*»s",  typename,  type_length  ) 

if  (  strcmp!  type_name,  "CHARACTER"  )  ==  0  ) 
return!  duplicate!  "CHARACTER '1 "  )  ); 

if  (  strcmp!  type_name,  "COMPLEX"  )  ==  0  ) 
return!  duplicate!  "COMPLEX‘8"  )  ); 

if  (  strcmp!  type_name,  "DOUBLE_PRECISION"  )  ==  0  ) 
return!  duplicate!  "REAL* 8"  )  ); 

if  (  strcmp!  type_name,  "INTEGER"  )  ==  0  ) 
return!  duplicate!  default_integer  )  ); 

if  (  strcmp!  type_name,  "LOGICAL"  )  ==*  0  > 
return!  duplicate!  default_logical  )  ); 

if  (  strcmp!  type_name,  "REAL"  )  ==  0  ) 
return!  duplicate!  "REAL*4"  )  ); 

return!  duplicate!  type_name  )  ); 

(  /»  type  */ 


)  ; 


FILE:  declare/1 ibrary/uppe  case.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


char  ‘uppercase!  string  ) 
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register  char  ‘string; 

( 

register  int  index  =  0; 

while  (  string[  index  )  !=  '\0'  ) 

( 

string!  index  )  =  toupper(  string!  index  ]  ); 
index++; 

1 

return!  string  ); 

)  /*  uppercase  */ 


FILE:  declare/library/yyerror.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 


extern  int  yylineno; 


void  yyerror!  string  ) 
register  char  ‘string. 

< 

fprintf!  stderr,  "line  %d,  %s\n",  yylineno,  string  ); 

exit (  -1  )  ; 

)  /*  yyerror  */ 


FILE:  declare/library/yygetc. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 
♦include  <ctype.h> 


extern  int  yylineno; 


int  tab!  length  ) 
register  int  length; 

( 

while  (  length —  !=  0  ) 
yyunput (  *  '  ) ; 

return (  •  *  ) ; 

}  /*  tab  */ 


int  yygetc!  file  ) 
renlster  FILE  ‘file; 

( 

int  c; 

int  column [  6  ]  ; 
loop: 

if  (  (  c  =  getcf  file  )  )  «»  '\t'  ) 
c  =  tab !  6  ) ; 

if  (  c  ! =  1 \n '  ) 
return (  c  ) ; 
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if 

(  (  column!  0  1  =  getc! 
goto  abort_0; 

file  ) 

)  !=  ‘ 

) 

if 

(  (  column!  1  1  =  getc! 
goto  abort_l; 

file  ) 

)  !=  1 

) 

if 

(  (  column!  2  1  =  getc! 
goto  abort_2; 

file  ) 

)  !=  ' 

) 

if 

(  (  column!  3  ]  =  getc! 
goto  abort_3; 

file  ) 

)  !=  1 

) 

if 

!  !  column!  4  1  =  getc! 
goto  abort  4; 

file  ) 

)  ’=  * 

) 

if 

(  isspace!  column!  5  ] 

=  getc! 

file  ) 

) 

goto  abort_5; 

yylineno++; 
goto  loop; 

abort_5 : 

if  (  column!  5  1  ==  '\t'  ) 
tab <  1  )  ; 

else 

{ 

yyunput (  column!  S  )  ); 
if  (  column!  5  1  ==  '\n'  ) 
yylineno++; 

1 

abort_4 : 

if  (  column!  4  1  --  '\t'  ) 
tab (  2  ) ; 
else 
{ 

yyunput!  column!  4  ]  ); 
if  (  column!  4  ]  -=  '\n'  ) 
yylineno++; 

1 

abort  3: 

if  (  column!  3  )  ==  '\t'  ) 
tab!  3  ) ; 
else 

{ 

yyunput |  column!  3  J  ); 
if  (  column!  3  ]  ==  '\n'  ) 
yylineno++; 

1 

abort_2 : 

if  (  column!  2  ]  ==  ' \f  ) 
tab (  4  )  ; 
else 
1 

yyunput!  column!  2  ]  ); 
if  (  column!  2  ]  ==  ’\n'  ) 
vylineno++; 

) 

abort  1: 

iF  (  column!  1  ]  »»  '\t'  ) 
tab (  5  )  ; 

else 

( 

yyunput!  column!  11); 
if  (  column!  1  1  =*=  * \n'  ) 
yylineno++; 

1 

abort_0 : 

if  (  column!  0  ]  ==  ' \t'  ) 
tab (  6  ) ; 

else 

! 

yyunput (  column (  0  ]  )  ; 
if  (  column!  0  1  *\n'  ) 

yy 1 ineno++ ; 

) 

return (  c  ) ; 

}  /*  yygetc  */ 


FILE:  declare/library/yywrap.c 
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/* 

*  Copyriaht  1991 

*  Georgia  Institute  or  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


int  yywrapf  ) 

( 

return (  1  ) ; 
)  /*  yywrap  */ 


FILE:  declare/scanner . 1 


*{ 

/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 

%1 


ta  10000 
%e  10000 
%k  10000 
%n  10000 
%o  10000 

»p  10000 


a  [aA] 
b  [bB] 
c  [cC] 
d  fdD] 
e  [eE] 
f  [fFl 
g  tgGl 
h  [hHJ 
i  [ill 
j  [jJl 
k  [kK] 
1  [1L1 

m  [mM] 
n  [nN] 
o  [oO  j 
P  CpP] 

q  (qQl 
r  [rR] 
s  [sS] 
t  [tT] 
u  [uU) 
v  [vV] 
w  [wW] 
x  [xX] 

y  tyY] 

z  [zZ] 


%< 

#include  "grammar. h" 
extern  char  *yylval; 


#undef  YYLMAX 
((define  YYLMAX  <25 6*20) 


extern  char  'duplicate!  ) ; 
extern  char  *hoilerith(  ) ; 
extern  char  *non_biank(  ) ; 
extern  char  'uppercase  (  ) ; 

»1 
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%% 


/>[\*cC]  .*{\n]  | 

't\  ) *  1 \n)  { 

•ifdef  DEBUG 
ECHO; 

•endif 

yylval  »  duplicate!  yytext  ); 
return!  COMMENT  ); 

1 


[\  1  { 

#ifdef  DEBUG 
ECHO; 

•endif 

/*  return!  ' \  '  )  */; 

1 


[\il  ( 

#ifdef  DEBUG 
ECHO; 

•endif 

return!  '\&*  ); 

> 


C\ (1  ! 

♦ifdef  DEBUG 
ECHO; 

#endl f 

return (  '  \  ( '  ) ; 

1 


C\>  1  ( 

iifdef  DEBUG 
ECHO; 

#endi f 

return (  ' \)  '  ) ; 

1 


[\*1  ( 

•ifdef  DEBUG 
ECHO; 

•endi f 

return (  1  \*  '  )  ; 

1 


(\*)[\*1  ! 

•ifdef  DEBUG 
ECHO; 

•endi f 

return!  EXPONENTIATE  ); 

1 


[U]  ( 

•ifdef  DEBUG 
ECHO; 

•endi f 

return (  ' \+ 1  ) ; 

1 


[\,  1  ( 

•ifdef  DEBUG 
ECHO; 

•endi f 

return (  ' '  ) ; 

) 


1  ( 

•ifdef  DEBUG 
ECHO; 

•  endi  f 
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return (  ' \- •  ) ; 

1 


[\.i  ( 

#ifdef  DEBUG 
ECHO; 

(tendif 

return (  ' \ '  )  ; 

) 


[\/l  { 

lifdef  DEBUG 
ECHO; 

(tendif 

return  (  ' \ / •  ) ; 

} 


[\:l  ( 

#i fdef  DEBUG 
ECHO; 

#endif 

return (  • \ : '  ) ; 

) 


[\  =  ]  { 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  ' \= '  ) ; 

) 


[  \n]  ! 

#ifdef  DEBUG 
ECHO; 

(tendif 

/*  return!  '\n'  )  */; 

t 


[\tl  ( 

#ifdef  DEBUG 
ECHO; 

(tend!  f 

/*  return!  '\t'  )  */; 

) 


[\.]{a)(nHdK\.]  ( 

#ifdef  DEBUG 
ECHO; 

Kendi f 

return!  RW_AND  ); 

) 


IN.] (e)fq) [\.]  ; 

#i fdef  DEBUG 
ECHO; 
ftendi  f 

return!  RW_EQ  ); 

1 


[\. ] !e) (q) (v> [\.  ]  ( 

# i fdef  DEBUG 
ECHO; 

(tendi  f 

return!  RW_EQV  ); 

} 


(\.](f)(a)(l)(s){el(\.)  ( 

# i f de  f  DEBUG 
ECHO; 

#endl  f 


return (  RW  FALSE  ) ; 
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) 


[\.| <gl<e)  [\.l  1 

#ifdef  DEBUG 
ECHO; 

#endif 

return  (  RW_GE  ) ; 

1 


[\ • 1 lg) 1 1}[\.  1  1 
#ifdef  DEBUG 
ECHO; 

#endif 

return  (  RW  GT  ) ; 


t\-l (11(e) [ \ - 1  ( 

#i fdef  DEBUG 
ECHO; 
lendif 

return (  RW_LE  ) ; 

1 


!\.|(lHt!(\.l  { 

#i  fdef  DEBUG 
ECHO; 

#endif 

return  (  RW_LT  ); 

1 


[\.Jln){e>[\.]  { 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_NE  ); 

} 


[\.|(nl(el(ql(v)l\.l  ( 

#i fdef  DEBUG 
ECHO; 

#endif 

return (  RW  NEQV  ); 

1 


f  \  -  )  (nMo)  itt  [\.)  ( 

# i fdef  DEBUG 
ECHO; 

#endi f 

return (  RW_NOT  ); 

) 


t\-l  (oHrl  t\.l  1 

#ifdef  DEBUG 
ECHO; 
lend! f 

return!  RW_OR  ); 

) 


[\ .  ]  ItKrKuHe)  [\.]  { 

# i fdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_TRUE  ) ; 

) 


UllslUMillgHn!  ( 

#i fdef  DEBUG 
ECHO; 

#endi f 

return!  RW_ASSIGN  ); 

) 
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(b)(aHc)ilc)(sllpHal(c|(e|  ( 
tifdef  DEBUG 
ECHO; 

#endif 

return (  RW_BACKSPACE  ); 

) 


|bHlllo|(c)|k|l\  IMdHaHtHa)  ( 
(tifdef  DEBUG 
ECHO; 

Itendif 

return (  RW_BLOCK_DATA  ) ; 

1 


(cHal(lHl)  { 

(tifdef  DEBUG 
ECHO; 
itendif 

return (  RW_CALL  ); 

) 


(cHh!(aHr!(al(cllt)leHrl  ( 
tifdef  DEBUG 
ECHO; 
tendi f 

return (  RW_CHARACTER  ) ; 

1 


(clUHoKsHe!  { 

#i fdef  DEBUG 
ECHO; 

#endi f 

return!  RW_CLOSE  ) ; 

) 


{ c  H  o  M  m )  { m }  (  o !  { n }  { 

#i fdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_COMMON  ) ; 

) 


IcMoHmMp}  (lHeHxf  { 

#i fdef  DEBUG 
ECHO; 

#endi f 

return (  RW_COMPLEX  ) ; 

) 


(c)(0) (n) (t)fi) !n)|u](e]  ( 

(tifdef  DEBUG 
ECHO; 
iendi f 

return  (  RW_CONTINUE  ); 

) 


(d) ( a ) ( t ) ( a  I  ( 
tifdef  DEBUG 
ECHO; 

«enuii 

return!  RW_DATA  ); 

) 


(d((i)(m)(e)(n)(s)(i)(o)(n)  { 

(tifdef  DEBUG 
ECHO; 

Itendi  f 

return!  RW_DIMENSION  ); 

) 
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{ d) ( o }  ( 

Iifdef  DEBUG 
ECHO; 

#endi  f 

return (  RW_DO  ); 

1 


td)|o||uHbl{ll|e)[\  1  *  ( pM  r  ||e)(cK  i  )(  s  ((  i  )( o}  ( n(  ( 
Iifdef  DEBUG 
ECHO; 

#endi f 

return!  RW_DOUBLE_PRECISION  ); 

) 


(eHlHsHel  ( 

Iifdef  DEBUG 
ECHO; 
lendi  f 

return (  RW_ELSE  ) ; 

1 


{eHlHsMeJ[\  IMiHfl  { 
#i fdef  DEBUG 
ECHO; 

#endi f 

return!  RW_ELSE_IF  ); 

} 


(ellnHdl  { 
iifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_END  ) ; 

1 


I e) f n > ( d) ( \  ] * { i ) ( f  1  { 

# i tdef  DEBUG 
ECHO; 

Kendif 

return (  RW_END_IF  ) ; 

1 


(e}(n)fd)(f){ij(l)(e)  ( 

Iifdef  DEBUG 
ECHO; 
lendi f 

return!  RW_ENDFILE  ); 

) 


{e)(n)(t)(r)(yl  { 

Iifdef  DEBUG 
ECHO; 
lendi f 

return (  RW_ENTRY  ) ; 

) 


|e)(qHuHi}|v]|aHlMeHn)|c)|e)  f 
Iifdef  DEBUG 
ECHO; 
lendi f 

return!  RW_EQU I VALENCE  ); 

1 


(elUl(t)(el[rl|n]|a!|ll  ( 
Iifdef  DEBUC 
ECHO; 
lendi f 

return!  RW_EXfERNAL  ); 

) 
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ifllollrl  .*  { 

Kifdef  DEBUG 
ECHO; 

Ifendi  f 

yylval  =  duplicate!  yytext  ); 
return!  RW_FORMAT  ); 

) 


(fl'rUnUclItKiHoHr)  ( 

#i fdef  DEBUG 
ECHO; 

#endi f 

return!  RW_FUNCTION  ); 

1 


(ql (o( [\  l *(t) (o)  f 
iti  fdef  DEBUG 
ECHO; 

#endi f 

return!  RW_GO_TO  ); 

} 


(i)tfi  { 

#ifdef  DEBUG 
ECHO; 
lendif 

return (  RW_IF  ) ; 

) 


(iHr  llpKlHillcHiUtl  ( 

#i fdef  DEBUG 
ECHO; 

#endi f 

return!  RW_IMFLICIT  ); 

) 


(iHn)lcHlHul(dlle)  f 
Iti  fdef  DEBUG 
ECHO; 

#endif 

return!  RW  INCLUDE  ); 

1 


(iKnllqlluHiHrlfe)  ( 

# i fde  f  DEBUG 
ECHO; 
itendi  f 

return (  RW  INQUIRE  ) ; 

) 


(il(n) (t) (e)!g)(e)ir)  { 

# i f def  DEBUG 
ECHO; 

#endi  f 

return!  RW_INTEGER  ); 

) 


(if{n({t}!rMiMnj(sl{i){c(  i 
# i f de  f  DEBUG 
ECHO; 

Itendi f 

-eturn!  RW_INTRINSIC  ); 

1 


(l)f°Hg){iHc!  (a)(1)  i 
ft i fdef  DEBUG 
ECHO; 

Itendi  f 

return!  RW  LOGICAL  ); 

} 
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(nHallmllellllliHsIlt)  ( 
fifdef  DEBUG 
ECHO; 

#endi £ 

return  (  RW_NAMELIST  .)  ; 

) 


(oKpKellnl  { 

#i fdef  DEBUG 
ECHO; 

Dendif 

return)  RW_OPEN  ); 

) 


(p](a||rHaHmHe!(tHe)|rl  { 
#ifdef  DEBUG 
ECHO; 

(tendi  f 

return)  RW_PARAMETER  ); 

1 


{ P } (a)tu) )s} )e}  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_PAUSE  ) ; 

1 


(p)|r)|lHn)|t)  { 

#ifdef  DEBUG 
ECHO; 

#endi f 

return)  RW_PRINT  ); 

1 


!pHrl(oHgllr)(aHm}  ( 
#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_PROGRAM  ) ; 

1 


(rHeHaUd)  ! 
lifdef  DEBUG 
ECHO; 

#endi f 

return)  RW_READ  ); 

} 


( rife) (a)  1 1}  { 

# i fdef  DEBUG 
ECHO; 

#endif 

return)  RW_REAL  ); 

) 


(r}(e)(t)(u)(r({n)  ( 

Kifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_RETURN  ) ; 

) 


( r ) (e) (w){ i > ( n) (d)  ( 

# i fdef  DEBUG 
ECHO; 

Dendi f 

return)  RW_REWIND  ) ; 

) 


(s((a) (v) (e) 


( 
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lifdef  DEBUG 
ECHO; 
lendi f 

return (  RW_SAVE  ) ; 

} 


Is)  { t }  (oUpl  { 
lifdef  DEBUG 
ECHO; 
lendi f 

return  (  RW_STOP  ); 

1 


(s||uKb!lrHoHuHt)UHnHei 
lifdef  DE3UG 
ECHO; 
lendi f 

return  (  RW_SUBROUTINE  ); 

1 


ItHhlleHn)  { 
lifdef  DEBUG 
ECHO; 
lendi  f 

return (  RW_THEN  ); 

1 


(t}(o)  { 

lifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_TO  ) ; 

1 


( w  > (r}(i)(t) (e)  ( 

lifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_WRITE  ) ; 

1 


{u){n){d}(e)(fiii}(n)(e>(d| 

lifdef  DEBUG 
ECHO; 
lendi f 

return  (  RWJJNDEFINED  ); 

( 


[%a-zA-Z] [_a-zA-Z0-9] *  < 
lifdef  DEBUG 
ECHO; 
lendif 

yylval  =  duplicate!  uppercase!  yytext  )  ); 
return!  IDENTIFIER  ); 

) 


“[0-9  1 [0-9  I [0-9  1 [0-9  ;[0-9  ) [ \  J  { 
lifdef  DEBUG 
ECHO; 
lendi f 

yylval  =  duplicate!  non_bIanx{  yytext  )  ); 

return!  LABEL  ); 

1 


r  0- 9  ]  ♦  I 

[0-9j*/\.[a-zA-Z]+\.  ( 

lifdef  DEBUG 
ECHO; 
lendif 

vylvai  =  duplicate!  yytext  ); 
return  !  INTEGER  ) ; 
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[0-9] +\. [0-91* ( [eE) [\+\-] ?[ 0-91+) ? 

[ 0-9]  *\ .  [0-9]  +  ([eEl  [\+\-]  ?  [0-9]  +  )  ? 
[0-91 +  ( [eE]  [\+\-l  ?  [0-9]+)  ?  { 
itifdef  DEBUG 
ECHO; 

#endif 

yylval  =  duplicate (  yytext  ); 
return (  REAL  ); 

1 


[0-9] +\. [0-9] * ( [dD] [\+\-l ? [0-9]+) ?  I 
[0-9]*\. [0-9]  +  (  [dD]  [ \ + \— 1 ? [0-9] +) ?  I 
[0-91+ ( [dD] [\+\-I ? [0-9] +> ? ( 

Itifdef  DEBUG 
ECHO; 

Kendi f 

yylval  =  duplicate]  yytext  ); 
return (  DOUBLE_PRECISION  ); 

1 


V[*\']*\’  I 
\"['\"]*\"  i 
#i fdef  DEBUG 
ECHO; 

#endif 

yytext [  0  ]  -  • \B'; 

yytext  [  strlent  yytext  )  -  1  ]  =  ' \” 1 ; 
yylval  «  duplicate]  yytext  ); 
return]  STRING  ); 

) 


[0-91+thH]  ( 

Itifdef  DEBUG 
ECHO; 

#endi f 

yylval  =  duplicate]  hollerith]  yytext,  •  \ 1  )  ); 
return]  HOLLERITH  ); 

) 


FILE:  declare/statement/Makefile 


# 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


CC  =  cc  -g 
INCLUDE  =  ../include 
CFLAGS  =  -IS (INCLUDE) 
LIBRARY  =  statement. a 


OBJECTS  =  \ 

b.' ock_data_statement .  o  \ 
common_statement . o  \ 
data_statement . o  \ 
declaration_statement . o  \ 
dimension_statement . o  \ 
do_statement . o  \ 
equivalence_statement . o  \ 
end_statement . o  \ 
function_statement . o  \ 
implicit_statement .o  \ 
parameter_statement . o  \ 
program_statement . o  \ 
subroutine  statement. o 


$ (LIBRARY) : S (OBJECTS) 
rm  -f  $  (LIBRARY) 
ar  crv  S (LIBRARY)  $ (OBJECTS) 
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ranlib  $ (LIBRARY) 

.SUFFIXES:  .c  .0 
•  c.o: 

$<CC)  -c  $  (CFLAGS)  $< 


clean: 

rm  -f  S (LIBRARY)  S (OBJECTS) 


FILE:  declare/statement/block  data  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  "list.h" 
♦include  "table. h" 
♦include  "attribute. h" 


void  block_data  statement (  identifier  ) 
register  char  "Identifier; 

( 

number_table  =  add_table (  identifier,  IMPLICIT  I  GLOBAL  I  VARIABLE  I  PROGRAM  ); 
)  /*  block  data  statement  */ 


FILE:  declare/statement/common  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  "list.h" 
♦include  "table. h" 
♦include  "attribute . h" 


extern  char  "duplicate (  ); 
extern  char  "parse (  ) ; 


void  common_statement (  common_narae,  common_list  ) 
register  char  *common_name; 
register  char  *common_list; 

{ 

register  char  "common; 
register  char  "identifier; 
register  char  *subscript_list; 
register  LIST  "temporary; 

if  (  common_name  ==  0  ) 

common_name  =  duplicate)  "BLKCOM"  ); 

add_list<  0,  common_name,  0,  0,  IMPLICIT  I  GLOBAL  I  CONSTANT  I  COMMON  ); 

if  (  find_table(  common_name  )  ==  -1  ) 

add_tabie (  common_name,  IM!  LICIT  I  GLOBAL  !  CONSTANT  I  COMMON  ); 

while  (  common  =  parse)  common_list  )  ) 

f 

identifier  =  parse)  common  ); 
subscript_list  =  parse)  common  ); 

temporary  =  delete_list(  0,  identifier  ); 

if  (  subscript_list  ==  0  ) 

add_list(  common_name,  identifier,  0,  subscr i pt_l i st ,  IMPLICIT  I  LOCAL  I 


VARIABLE  ); 
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else 

add_list(  common_name,  identifier,  0,  subscript_list,  IMPLICIT  I  LOCAL  I 
VARIABLE  I  ARRAY  ) ; 

if  (  temporary  !=  0  ) 

add_list(  common_name,  identifier,  temporary->type,  temporary->subscript_list, 
temporary->attribute  )  ; 

) 

)  /*  common  statement  */ 


FILE:  declare/statement/data  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <string.h> 
♦include  "list.h" 
♦include  “attribute. h” 


extern  char  “parse (  ) ; 
extern  char  “list (  )  ; 
extern  char  “merge (  )  ; 


void  data_statement (  data_list  ) 
register  char  “data_list; 

1 

register  char  “data; 
register  char  “variable; 
register  char  “constant_list; 
register  LIST  “temporary; 

while  (  data  =  parse (  data_list  )  ) 

{ 

variable  *  parse (  data  ) ; 

variable!  strcspnl  variable,  "()“  )  1  =  ' \ 0 ' ; 

constant_list  -  parse (  data  ); 
constant_list  =  list(  constant_list,  ); 

temporary  =  add_list (  0,  variable,  0,  0,  IMPLICIT  I  LOCAL  I  VARIABLE  ); 
temporary->number--; 

if  (  temporary->data  !=  0  ) 

temporary->data  *  merge {  "%s,  %s",  temporary->data,  constant_list  ); 

else 

temporary->data  =  constant_list; 

) 

}  /“  data  statement  */ 


FILE:  declare/statement/declaration  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


•include  "list.h" 
♦include  "attribute. h" 


extern  char  “parse!  ); 


void  decla rat ion_st atement (  type,  decl a  rat i on_l i st  ) 

register  char  “type; 

register  char  *declaration_l ist ; 

( 
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register  char  'declaration; 
register  char  'identifier; 
register  char  *subscript_list; 

while  (  declaration  =  parse)  declaration_list  )  ) 

{ 

identifier  =  parse)  declaration  ); 
subscript_list  =  parse)  declaration  ); 

if  (  subscript_list  ==  0  ) 

add_list (  0,  identifier,  type,  subscript_list,  EXPLICIT  I  LOCAL  I  VARIABLE  ) 
else 

add_list (  0,  identifier,  type,  subscript  list,  EXPLICIT  I  LOCAL  I  VARIABLE  I 

ARRAY  ) ; 

) 

)  /'  declaration  statement  */ 


FILE:  declare/statement/dimension  statement. c 


/' 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Engineering  Research  Laboratory 
’  Author:  Stephen  R.  Wachtel 

*/ 


♦include  “list.h" 
♦include  "attribute . h” 


extern  char  'parse)  ); 


void  dimension_statement (  dimension_list  ) 
register  char  'dimension_list; 

{ 

register  char  'dimension; 
register  char  'identifier; 
register  char  *subscript_list; 

while  (  dimension  =  parse)  dimension  list  )  ) 

( 

identifier  =  parse)  dimension  ); 
subscript_list  =  parse)  dimension  ); 

add_list(  0,  identifier,  0,  subscript  list,  IMPLICIT  I  LOCAL  I  VARIABLE  I  ARRAY 

) 

)  /*  dimension  statement  '/ 


FILE:  declare/statement/do  statement. c 


/* 

'  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  "list.h" 
♦include  "att ribute . h" 


void  do_statement (  label,  identifier,  expression  list  ) 
register  char  'label; 
register  char  'identifier; 
register  char  *expression_list; 

{ 

add_list (  0,  identifier,  0,  0,  IMPLICIT  I  LOCAL  I  VARIABLE  )->number++; 
)  /'  do  statement  */ 
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*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


void  end_statement (  ) 

( 

implicit_initialize (  ); 
}  /*  end_statement  */ 


FILE:  declare/statement /equi valence_st atement .c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  "list.h" 
♦include  "attribute. h" 


extern  char  "parse (  )  ; 


void  equivalence_statement (  equivalence_list  ) 
register  char  *equivalence_list; 

t 

register  char  *variable_list; 
register  char  "variable; 
register  char  "identifier; 
register  char  *subscript_list; 

while  (  variable_list  =  parse (  equivalence  list  )  ) 

{ 

while  (  variable  «  parse!  variable_list  )  ) 

{ 

identifier  »  parse!  variable  ); 
subscript_list  =  parse!  variable  ); 

add_list (  0,  identifier,  0,  0,  IMPLICIT  I  LOCAL  I  VARIABLE  I  EQUIVALENCE  ) 
t 

1 

)  /*  equivalence_statenent  */ 


FILE:  declare/statement/function  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  "list.h" 
♦include  "table. h" 
♦include  "attribute . h" 


extern  char  "parse!  ); 


void  function_statement (  optional_type,  identifier,  optional_formal_argument_list  ) 

"•gi - - *optional_type; 

register  char  "identifier; 

register  char  *optional_formal_argument_list; 

( 

register  char  * f ormal_argument ; 

number_table  =  add_tabie(  identifier,  IMPLICIT  I  GLOBAL  !  VARIABLE  I  FUNCTION  ); 
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add_list(  0,  identifier,  optional_type,  0,  EXPLICIT  I  LOCAL  I  VARIABLE  I  FUNCTION 

)  ; 

else 

add_list (  0,  identifier,  optional_type,  0,  IMPLICIT  I  LOCAL  I  VARIABLE  I  FUNCTION 

)  ; 

if  (  optional_formal_argument_list  !=  0  ) 

1 

while  (  formal_argument  =  parse (  optional_formal_argument_list  )  ) 

add_list (  0,  formal_argument,  0,  0,  IMPLICIT  I  LOCAL  I  VARIABLE  I 
FORMAL_ARGUMENT  )  ; 

} 

}  /*  function_statement  */ 


FILE:  declare/ st atement / impl ici t_st atemen t . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  P.esearch  Laboratory 
'  Author:  Stephen  R.  Wachtel 

*/ 


extern  char  'parse!  ); 


void  implicit_statement (  type,  implicit_list  ) 
register  char  'type; 
register  char  *implicit_list; 

{ 

register  char  'implicit; 
register  char  'lower_bound; 
register  char  'upper_bound; 

while  (  implicit  -  parse!  implicit_list  )  ) 

( 

lower_bound  »  parse!  implicit  ); 

upper_bcund  =  parse!  implicit  ); 

type_implicit (  type,  lower  bound,  upper  bound  ) ; 

) 

update_list (  0  ) ; 

)  /'  impl icit_statement  '/ 


FILE :  declare/ st atement /parameter_statement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


iinclude  "list.h" 
Kinclude  "at t ribute . h" 


extern  char  'parse!  ); 


void  parameter_statement (  parameter_list  ) 
register  char  *parameter_list; 

1 

register  char  'parameter; 
register  char  'identifier; 
register  char  'expression; 
register  LIST  'temporary; 

while  (  parameter  =  parse!  parameter_l ist  )  ) 

{ 

identifier  =  parse!  parameter  ); 
expression  =  parse!  parameter  ); 

temporary  =  add_list(  0,  identifier,  0,  0,  IMPLICIT  I  LOCAL  I  CONSTANT  ) ; 
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tempo ra ry->number++; 
temporary->data  =  expression; 

) 

)  /*  parameter_statement  */ 


FILE:  declare/ statement /program_statement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
»/ 


♦include  "list.h" 
♦include  "table. h" 
♦include  "attribute. h" 


void  program_statement (  identifier  ) 
register  char  "identifier; 

{ 

numbe r_table  =  add_table(  identifier,  IMPLICIT  I  GLOBAL  I  CONSTANT  I  PROGRAM  ) 
)  /*  program_statement  */ 


FILE:  declare/statement/subroutine  statement. c 


/" 

»  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  "list.h" 
♦include  "table. h" 
♦include  "attribute. h" 


extern  char  "parse!  ); 


void  subroutine  statement!  identifier,  optional_formal_argrument_l ist  ) 
register  char  "Tdenti f ier; 

register  char  *optional_formal_argument_list; 

{ 

register  char  *formal_argument; 

numbe r_t able  -  add_table<  identifier,  IMPLICIT  I  GLOBAL  I  CONSTANT  I  FUNCTION  ) 

if  (  optional_formal_argument_li st  !  =  0  ) 

( 

while  (  f ormal_argument  =  parse!  optional_formal_argument_list  )  ) 

add_list (  0,  f ormal_argument ,  0,  0,  IMPLICIT  I  LOCAL  I  VARIABLE  I 
FORMAL_ARGUMENT  ) ; 

1 

}  /*  subroutine  statement  */ 
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12.  Appendix  G:  equivalence  program  source 

FILE:  equivalence/Makef ile 


# 

#  Copyright  1991 

f  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


default:  equivalence 


CC  =  cc  -g 
INCLUDE  =  include 
CFLAGS  =  -1$ (INCLUDE) 

LIBRARY  =  statement/statement . a  library/library . a 


OBJECTS  -  \ 

$ (INCLUDE) /grammar. h  \ 
•grammar. [co]  \ 
•scanner. (co]  \ 
yy trace. [co]  \ 
y. output 


PROGRAMS  -  \ 

•equivalence 


grammar,  c:  gramma  '.y 
yacc  -dv  grammar. y 
mv  y.tab.h  $( INCLUDE) /grammar . h 
mv  y.tab.c  grammar.c 


scanner. c:  scanner. 1 

lex  -vt  scanner. 1  I  sed  ■ s/getc/yygetc/ '  >scanner.c 


scanner. o:  scanner. c 

$(CC)  $ (CFLAGS)  -c  scanner. c 

grammar. o:  grammar.c 

S  (CC)  S  (CFLAGS)  -c  grammar.c 

equivalence:  grammar. o  scanner. o  S (LIBRARY) 

$ (CC)  -o  equivalence  grammar. o  scanner. o  $ (LIBRARY) 


sgrammar . c :  grammar . c  yytoken.awk 

awk  -f  yytoken.awk  <grammar.c  >sgrammar.c 

sgrammar. o: sgrammar. c 

$(CC)  S (CFLAGS)  -c  sgrammar. c 

sequi valence :  sgrammar. o  scanner. o  $ (LIBRARY) 

$(CC)  -o  sequivalence  sgrammar.o  scanner. o  $ (LIBRARY) 


dscanner.c:  scanner. c 

cp  scanner. c  dscanner.c 

dscanner.o: dscanner.c  S (INCLUDE) /grammar.h 
$(CC.  S (CFLAGS)  -DDEBUG  -c  dscanner.c 

dequivalence:  grammar. o  dscanner.o  S (LIBRARY) 

S (CC)  -o  dequivalence  grammar.o  dscanner.o  S(LIBRARY) 


tgrammar . c: grammar . c 

sed  ' s/yystack : /&  yytrace (yystate) ; / '  <grammar.c  >tgrammar.c 


tgrammar.o: tgrammar.c 

S(CC)  S (CFLAGS)  -c  tgrammar.c 
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tequivalence:  tgrammar.o  scanner. o  yytrace.o  $ (LIBRARY) 

$ (CC)  -o  tequivalence  tgrammar.o  scanner. o  yytrace.o  $ (LIBRARY) 


yytrace.c:  grammar .c  yytrace.awk 

awk  -f  yytrace.awk  <y. output  >yytrace.c 

yytrace.o:  yytrace.c 

$  (CC)  $ (CFLAGS)  -c  yytrace.c 


clean: 

cd  statement;  make  clean 
cd  library;  make  clean 
rm  -f  $ (PROGRAMS)  $ (OBJECTS) 


FILE:  equivalence/grammar . y 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
»/ 


/* 

*  FORTRAN  77 
*/ 


%token  RW_AND 
%token  RW_ASSIGN 
%token  RWBACKSPACE 
»token  RW_BLOCK_DATA 
ttoken  RW_CALL 
ttoken  RW_CHARACTER 
%token  RW_CL0SE 
%token  RW_COMMON 
%token  RW  COMPLEX 
%token  RW~CONTINUE 
%token  RW_DATA 
%token  RW_D I MEN SION 
ttoken  RW_DO 

ttoken  RW_DOUBLE_PRECISION 

ttoken  RW_ELSE 

ttoken  RW_ELSE_IF 

ttoken  RW_END 

ttoken  RW_END_IF 

ttoken  RW_ENDFILE 

ttoken  RW_ENTRY 

ttoken  RW_EQ 

ttoken  RW_EQUI VALENCE 

ttoken  RW_EQV 

ttoken  RW_EXTERNAL 

ttoken  RW_FALSE 

ttoken  RW_F0RMAT 

ttoken  RW_FUNCTION 

ttoken  RW_GE 

ttoken  RW_G0_T0 

ttoken  RW_GT 

ttoken  RW_IF 

ttoken  RW_IMPLICIT 

ttoken  RW_INCLUDE 

ttoken  RW_INQUIRE 

ttoken  RW_INTEGER 

ttoken  RW_INTRINSIC 

ttoken  RW_LE 

ttoken  RW_LOGICAL 

ttoken  RW_LT 

ttoker  RW_NAMELIST 

ttoken  RW_NE 

ttoken  RW_NEUV 

ttoken  RW_N0T 

ttoken  RW_0PEN 

ttoken  RW_0R 

ttoken  RW_PARA METER 

ttoken  RW_PAUSE 

ttoken  RW  PRINT 
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%token  RW_PROGRAM 
♦token  RW_READ 
♦token  RW_REAL 
♦token  RW_RETURN 
♦token  RW_REWIND 
♦token  RW_SAVE 
♦token  RW_STOP 
♦token  RW_SUBROUTINE 
♦token  RW_THEN 
♦token  RW_TO 
♦token  RW_TRUE 
♦token  RW_WRITE 
♦token  RW  UNDEFINED 


♦token  COMMENT 
♦token  CONCATENATE 
♦token  DOUBLE_PRECISION 
♦token  EXPONENTIATE 
♦token  HOLLERITH 
♦token  IDENTIFIER 
♦token  INTEGER 
♦token  LABEL 
♦token  REAL 
♦token  STRING 


♦left  • , • 

♦nonassoc  ' :  • 

♦right  '=' 

♦left  RW_EQV  RW_NEQV 
♦left  RWJDR 
♦left  RW_AND 
♦left  RW_NOT 

♦nonassoc  RW_EQ  RWNE  RW_LT  RW_LE  RW_GT  RW_GE 
♦left  CONCATENATE 
♦left  ■+' 

♦left  ■**  •/' 

♦right  EXPONENTIATE 
♦left  SIGN 


♦  f 

typedef  char  ‘POINTER; 
♦define  YYSTYPE  POINTER 


♦  include  '’list.h" 
LIST*  rlist  =  0; 
LIST*  ilist  =  0; 


char  *block_name  =  0; 
char  ‘common  name  =  0; 


extern 
extern 
extern 
extern 
extern 
♦  1 


POINTER  duplicate ( 
POINTER  merge!  ); 
POINTER  list!  ); 
POINTER  type!  ); 
POINTER  replicate! 


)  ; 


)  ; 


♦  ♦ 


program: 

optional_statement_list 


optional  statement_l i st : 
r*  NULL  */ 

I 

statement  list 


statement_i i st : 

statement 

I 

statement  list  statement 
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statement : 

comment_statement 

I 

label  unlabeled  statement 


comment_statement : 
COMMENT 


label : 

LABEL 


unlabeled_statement : 

include_statement 

I 

program_statement 

I 

block_data_statement 

I 

funct ion_statement 
I 

subrout ine_statement 

entry_statement 

I 

end  statement 

I 

sped  float ion_statement 
I 

executable_statement 

I 

format  statement 


include_statement : 

RW  INCLUDE  character  constant 


program_statement  : 

RW_PROGRAM  program_ident i f ie r 


pr ogram_i dent! fieri 
IDENTIFIER 
i 

5s  =  biock_name  =  Si; 

) 


block_data  statement: 

RW  BLOCK  DATA  block  data  Identifier 


bl ock_data_i dent i fieri 
IDENTIFIER 
( 

SS  =  block_name  -  SI; 

) 


function_statement: 

RW_FUNCTION  f  unct  i  orj_ident  i  f  i  er  optional  formal  argument  list 
I 

type  RW  FUNCTION  f  unct ; on_ ;  dent  i  f  ier  opt  i onal__forma  1  argument 


function  identifier: 


list 
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IDENTIFIER 

1 

$$  »  bl ock_name  =  SI; 

! 


subrout ine_statement : 

RW_SUBROUTINE  sub rout ine_ident i f ier 

I 

RW_SUBROUTINE  subrout  ine_ident  i  f  ier  optior.al_formal_argu-"’nt 


subrout i ne_ident i f ier : 

IDENTIFIER 

i 

SS  =  block_name  =  Si; 

) 


entry_statement : 

RW_ENTRY  entry_identif ier 

RW_ENTRY  entry_identifier  optional_formal_argument_iist 


er.try_identifier: 

IDENTIFIER 

( 

SS  =  SI; 

) 


opt  ior.al_formal_argument_l  i  st : 
'('•)' 

( 

SS  =  0; 

) 

'('  formal_argumer.t  list  ')' 
( 

SS  =•  $2; 

} 


formal  argument  list: 

formal  argument 

SS  =  merge (  "•%si",  SI  ); 


formal  a rgument_l i st  '  fornal_arguner.t 

SS  =  merge (  ” % 5 ; %s : " ,  SI,  S3  ); 

i 


f crma 1 _argumer t : 

$  S  -  SI; 


formal  argument  alternate  ret 


3 S  =  oup .  .mate  ( 


list 
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end_statement : 

RW_END 

t 

print_list(  rlist,  block_name  ); 
delete_list(  rlist  ); 
rlist  =  0; 

print_list  (  ilist,  block_name  ); 
delete_list  (  ilist  )  ; 
ilist  =  0 ; 

block  name  =  0; 

) 


specification  statement: 

exterrtal_statement 

I 

intrinsic_statement 

I 

parameter  statement 

I 

dimension  statement 

I 

declaration_statement 

I 

save_statement 

I 

common  statement 
I 

equi valence_statsment 
I 

implicit_statement 

I 

data_statement 

I 

namelist  statement 


external_statement : 

RW  EXTERNAL  external  list 


external_l i st : 

external 

( 

SS  =  merge!  " (%s}",  SI  ); 

1 

I 

external  list  '  external 

( 

SS  =  merge!  "%sf%sl",  SI,  S3  ); 

} 


external: 

IDENTIFIER 

I 

SS  -  SI; 

I 


mtrir. s:c_statement : 

PW  INTRINSIC  intrinsic  list 


intrinsic 

f 

S  S  =  merge!  ” t  %  s ) " ,  SI  ) ; 

! 
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intrinsic_list  intrinsic 

{ 

$$  =  merge!  "%s(%s}",  SI,  S3 

1 


intrinsic: 

IDENTIFIER 

{ 

$$  =  $1; 

) 


parameter_statement : 

RW_PARAMETER  1 ( '  parameter_list 


parameter_list : 

parameter 

{ 

$$  =  merge!  "!%s(" ,  S1  ); 

1 

I 

parameter_list  1  parameter 

{ 

$$  =  merge!  "%s(%s)H,  $1,  $3 

) 


parameter : 

IDENTIFIER  expression 

( 

$$  =  merge!  "(%s)f%s)",  $1, 

1 


dimension_statement : 

RW  DIMENSION  dimension  list 


dimension_list : 

dimension 

( 

S$  =  merge (  $1  > ; 


dimensi on_l i s t  '  dimension 

{ 

SS  =  merge!  "%s(%s)“ ,  SI,  $3 


dimension: 

IDENTIFIER  ' ( ' subscr ipt_l i st  ')' 

( 

SS  =  merge!  !%si” ,  SI, 

) 


subscr i pt_l i st : 

subscr  1  pt. 

! 

SS  *  merge!  SI  ); 


subscript  list  1 , '  subscript 

S3  -  merge!  "%s*%sr” ,  31,  S3 


SibSC 


:  p"-  : 


' )  ' 


) ; 


S3  )  ; 


)  ; 


S3  )  ; 
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upper_bound 

1 

$$  =  SI; 

) 

lower_bound  ’ : '  upper_bound 

1 

$$  -  merge  (  "%s:%s",  SI,  S3  ); 

1 


lower_bound: 

expression 

( 

$S  =  SI; 


upper_bound: 

expression 

( 

SS  »  SI; 

1 

I 

uppe r_bound_ad justable 

( 

SS  =  SI; 

) 


uppe r_bound_ad jus table : 

•  » > 

( 

SS  =  duplicate)  ); 

1 


declarat ion_statement : 

type"  declaration_list 


declarat ion_li st: 

declaration 

( 

SS  =  merge)  ")%s)n,  SI  ); 


declarat ion_l ist  declaration 

( 

SS  =  merge)  "%s{%s)",  SI,  S3  ); 

1 


declaration : 

IDENTIFIER 

i 

SS  =  merge)  "(%s)",  SI  ); 

1 

I 

IDENTIFIER  '('  subscri pt_l i st  ')’ 

f 

SS  =  merge)  ”(%sl(%s)",  SI,  $3  ); 

} 


type: 

type_name  opt iona 1 _t ype_iength 

( 

SS  *  type (  SI ,  S2  ) ; 


type  tame : 
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RW_CHARACTER 

( 

SS  -  duplicate {  "CHARACTER"  ) ; 

} 

I 

RW_COMPLEX 

{ 

SS  =  duplicate (  "COMPLEX"  ); 

} 

I 

RW_DOUBLE_PRECISION 

( 

SS  =  duplicate  (  "DOUBLE_PRECISION"  ); 

} 

I 

RW_INTEGER 

( 

SS  =  duplicate !  "INTEGER"  ); 

) 

I 

RW_LOGICAL 

( 

SS  =  duplicate (  "LOGICAL"  ); 

} 

I 

RW_REAL 

{ 

SS  =  duplicate (  "REAL"  ); 

1 

I 

RWJJNDEFINED 

{ 

SS  =  duplicate  (  "UNDEFINED"  ); 

1 


optional  type_length: 
F*  NULL  */ 

( 

SS  =  0; 
l 

I 

type_length 

( 

SS  =  SI; 

) 


type_length : 

'*'  INTEGER 

( 

SS  -  S2; 

) 

I 

type_length_ad justable 

f 

SS  =  S2 ; 

) 


type_ler.gth_ad  justable : 

( 

SS  =  duplicate!  "-1"  ); 

1 


save_statement : 

RW_SAVE  opt ionai _ save  list 


cptior.ai_save_lisb: 
/*  NULL  */ 

{ 

SS  »  0; 
t 
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save_list 

1 

$$  -  SI; 

) 


save_list : 

save 

{ 

$$  =  merge (  $1  ) ; 

) 

I 

save_list  save 

{ 

$  $  =  me  rge (  " %  s { %  s } " ,  51,  S3  ) ; 

! 


save: 


IDENTIFIER 

{ 

SS  =  SI; 

} 

common_name 

{ 

SS  -  SI; 

) 


common_statement : 

RW_COMMON  opt ional_common_name  common_variable_list 

{ 

common_name  =  0; 

) 


optional  common_name: 
r*  NULL  */ 

{ 

SS  »  common_name  =  0; 

) 

I 

common_name 

( 

SS  =  common_name  =  $1; 

) 


common_name : 

'/'  optional_identi f ier  '/' 

< 

SS  =  S2; 

) 


optional  identifier: 
r*  NULL  */ 

{ 

SS  =  Q; 

) 

IDENTIFIER 

( 

SS  =  SI; 

1 


common _va  riable_iist: 

common_ va  r i able 

f 

SS  =  merge!  SI  ); 

) 
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common_variable_list  common_variable 

( 

SS  =  merge (  "%s{%s(",  $1,  $3  ); 


common_var iable : 

IDENTIFIER 

{ 

SS  =  merge(  "(%s)",  $1  ); 

1 

! 

IDENTIFIER  '('  subscript_list  ')' 

{ 

SS  =  merge  (  "{%s){%s}",  SI,  S3  !; 

) 


equivalence_statemenC : 

RW_EQU I VALENCE  equivalence_list 


equivalence_list : 

equivalence 

t 

SS  =  merge (  "{%s)“,  SI  ); 

> 

I 

equivalence_list  equivalence 

{ 

SS  =  merge (  "%s(%s)u,  SI,  $3  ); 

} 


equivalence : 

'('  equivalence  variable  equivalence  variable 

( 

if  (  strncmp (  S2,  "VAR",  3  )  ==  0  ) 
add_list (  srlist,  0,  $4  ); 

if  (  strncmp(  S2,  "IVAR",  4  )  ==  0  ) 
add_list(  Silist,  0,  S4  ); 

SS  =  merge)  "(%s}(%s)",  $2,  S4  ) ; 

} 


equivalence_var iable: 

IDENTIFIER 

( 

SS  =  SI; 
t 
I 

IDENTIFIER  '('  subscript  list  ')' 

{ 

SS  =  SI; 

) 


implicit_statement : 

RW_IMPr,ICIT  type  '(’  implicit_list  ' )  ' 


impl ici t_li st : 

implicit 

( 

SS  -  merge (  "( %s} ",  SI  ) ; 

I 

I 

implicit_list  implicit 

( 

SS  =  merge!  "%s(%s)M,  SI,  S3  ); 

} 
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implicit : 

IDENTIFIER 

{ 

SS  =  merge  (  'Mis)",  SI  )  ; 

) 

I 

IDENTIFIER  IDENTIFIER 

( 

$$  =  merge (  " ( %s) ( %s) ",  $1,  S3  ); 

1 


namelist_statement : 

RW  NAMELIST  namelist  name  namelist  list 


namelist_name: 

V  IDENTIFIER  '/' 

{ 

S$  =  S2; 

) 


namelist_list : 

namelist 

( 

$S  =  merge (  "{%s}",  SI  ); 

1 

namelist  list  1  namelist 

1 

$$  =  merge!  "%s(%s)H,  SI,  S3  ); 

1 


namelist : 

IDENTIFIER 

( 

$S  =  SI; 

1 


data_statement : 

RW_DATA  data_l ist 

( 

data_statement  (  S2  ) ; 

1 


data_li st : 

data 

( 

SS  =  merge!  $1  ); 

) 

I 

data_list  optional_comma  data 

! 

SS  =  merge!  n%s(%s|",  $1,  S3  ); 

1 


data : 

data_va r iable_l i st  '/'  data_constant_list  V 

( 

SS  =  merge!  "(%s)(%sl",  SI,  S3  ) ; 

1 


data_variable_list: 

data  variable 
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I 


( 

SS  =  merge!  "(%s)",  $1  ); 

> 


data_variable_list  data_var iable 

{ 

$$  =  merge!  "ts{%s)",  $1,  S3  ); 

) 


data_variable : 

variable 

{ 

$5  =  SI; 

) 

data_impl ied_dn_1 List 

'  $$  =  SI; 

) 


data_implied_do_list : 

'(*  data_variable_list  IDENTIFIER  '=*  expression_list  ')' 

( 

$$  =  merge!  "  (  %s,  %s  =  %s  )",  list!  $2,  ",  ’■  ),  $4,  list!  $6,  ”,  ”  )  ); 

} 


data_constant_l ist : 

data_constant 

{ 

SS  =  merge!  "(%s)",  SI  ); 

} 

I 

data_constant  list  data_constant 

i 

SS  «  merge!  '%s(%s}",  $1,  $3  ); 

) 


data_constant : 

data_initial ization 

( 

SS  =  SI; 

) 

I 

IDENTIFIER  data_initialization 

( 

SS  =  merge!  "%s  *  %s",  SI,  S3  ); 

) 

! 

INTEGER  data_initialization 

{ 

SS  *  replicate!  atoi (  SI  ),  S3,  ”)("  ); 

) 


data_initialization; 

IDENTIFIER 

! 

SS  »  SI; 
i 

I 

character_constant 

( 

SS  =  SI; 

) 

I 

logical_constant 

( 

SS  »  SI; 

I 

signed_numerical_constant 

( 


182 


Annual  Report:  Digital  Emulation  Technology  Laboratory  Volume  1,  Part  2 


SS  =  $1; 

1 


signed_numerical_constant : 

numerical_constant 

{ 

S$  =  SI; 

) 

I 

'+'  numerical_constant  %prec  SIGN 

{ 

S$  =  merge  (  "  +  %s,‘ ,  $2  ); 

1 

I 

numerical_constant  %prec  SIGN 

{ 

$$  =  merge (  "-%sn,  S2  ) ; 

1 


expression: 

parenthesis_expression 

! 

SS  =  $1; 

1 

I 

simple_expression 

1 

SS  =  SI; 

) 


parenthesis_expression: 

' ( '  expression  ■ ) ' 

( 

SS  =  merge <  " <  %s  ) ",  $2  ) ; 

1 


simple_expre3sion : 
variable 
1 

SS  -  SI; 

) 

I 

constant 

f 

SS  =  $1; 

) 

I 

ari thmetic_expression 

{ 

SS  =  SI; 

1 

character_expression 

( 

$$  -  SI; 

) 

I 

relat ional_expressicn 

( 

SS  =  SI; 

1 

I 

logical_expression 

( 

SS  =  SI; 

) 

I 

unary_expression 

( 

SS  -  SI; 

( 
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variable : 

IDENTIFIER 

{ 

usage_list  (  rlist,  SI  )  ;' 
usage_list (  ilist,  $1  ); 

SS  =  SI; 

) 

I 

IDENTIFIER  str ing_subset 

( 

usage_list(  rlist,  SI  ); 
usage_list(  ilist,  SI  )  ; 

SS  =  merge!  "%s%s",  SI,  S2  ); 

) 

I 

array 

{ 

SS  -  SI; 

) 


array : 

IDENTIFIER  • (•  optional_expression_list 

( 

usage_list(  rlist,  $1  ); 
usage_list (  ilist,  SI  ) ; 

SS  =  merge!  "%s(%s)“,  SI,  list!  S3,  )  ); 

1 

I 

IDENTIFIER  opt ional_expressicn_l i st  *)*  string_subset 

1 

usage_list(  rlist,  SI  ); 
usage_list(  ilist.  Si  ); 

SS  =  merge!  "%s(%s)%s",  SI,  list!  S3,  ”  ),  S5  ); 

1 


optional  expression_list : 
r-  NULL  */ 

( 

SS  =  0; 

1 

i 

expression_lisc 

( 

SS  =  $1; 

( 


expression_list : 

expression 

( 

SS  =  merge!  SI  ); 

( 

I 

expression_l i st  expression 

( 

SS  =  merge!  ”%s{%s)",  $1,  S3  ); 

1 


St r i ngsubset : 

'('  optional_expression  cotional_expression  ’)' 

( 

SS  =  merge!  "(  %s  :  %s  )  ",  52,  S4  ); 

) 


optionai_expression: 
/*  NULL  */ 

! 
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$$  =  0; 

1 

I 

expression 

{ 

$$  =  SI; 

) 


constant : 

character_constant 

( 

SS  =  SI; 

( 

I 

logical_constant 

{ 

SS  =  SI; 

1 

I 

numerical_constant 

( 

SS  =  SI; 

} 


character_constant : 
HOLLERITH 
< 

SS  =  SI; 

( 

I 

STRING 

( 

SS  =  SI; 

) 


logical_constant : 

RW_FALSE 

{ 

SS  =  duplicate! 


RW_TRUE 

( 

SS  =  duplicate! 

) 


.FALSE."  )  ; 


"  .  TRUE .  )  ; 


numerical_constant : 

DOUBLE_PRECISICN 

( 

SS  -  SI; 

) 

I 

INTEGER 

{ 


REAL 

( 

SS  -  SI; 

> 


arithmetic_exp cession: 

expression  ' + 1 

( 

SS  ~  merge! 

) 

expression 

( 

SS  =  merge! 


expression  %prec 
"%s  +  %s",  SI,  $3  )  ; 

expression  %prec 
"%s  -  %s",  SI,  $3  >; 
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I 


I 


) 

expression  expression 

( 


$  $  =  me  rge  (  "  %  s 


%s”. 


%prec  1  *  1 
$1,  53  ); 


expression  '/'  expression  %prec  */' 

1 

5$  =  merge (  "%s  /  %s",  SI,  $3  ); 

I 

expression  EXPONENTIATE  expression  %prec  EXPONENTIATE 

( 


SS  =  merge (  "%s  **  %s",  $1,  S3  ); 

} 


character_expression : 

expression  '/'  '/'  expression  Iprec  CONCATENATE 

{ 

SS  =  merge (  "fcs  //  %s",  SI,  S4  ); 


relational_expression : 

expression  RW_EQ  expression  %prec  RW_EQ 

{ 

SS  =  merge!  "%s  .EQ.  %s",  SI,  S3  ); 

) 

I 

expression  RW_NE  expression  %prec  RW_NE 

< 

SS  =  merge!  "%s  .NE.  %s",  $1,  S3  ); 

) 

I 

expression  RW_LT  expression  %prec  RW_LT 

1 

SS  =  merge!  "%s  .LT.  %s‘\  $1,  $3  ); 

) 

I 

expression  RW_LE  expression  %prec  RW_LE 

( 

SS  =  merge!  "%s  . LE.  %s",  SI,  S3  ); 

) 

I 

expression  RW_GT  expression  %prec  RW_GT 

( 

SS  =  merge!  "%s  .GT.  %s",  SI,  S3  ); 

1 

I 

expression  RW_GE  expression  %prec  RW_GE 

( 

SS  =  merge!  "%s  .GE.  %s",  SI,  S3  ); 

) 


logica l_expression : 

expression  RW_AND  expression  %prec  RW_AND 

( 

SS  =  merge!  "is  .AND.  %s",  SI,  S3  ) ; 

1 

expression  RW_OR  expression  %prec  RW_OR 
( 

SS  =  merge!  "%s  .OR.  %s",  $1,  S3  ); 

) 

expression  RW_E0V  expression  %prec  RW_EQV 
! 

SS  =  merge!  "%s  .EQV.  %s”.  Si,  S3  ) ; 

) 

expression  RW_NEQV  expression  iprec  RW  NEQV 

! 

SS  =  merge!  "%s  .NEQV.  %s",  SI,  S3  ); 

) 
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unary  expression: 

~  *+'  expression  %prec  SIGN 

( 

S $  =  merge!  "  +  % s " ,  $ 2  ) ; 

) 

I 

expression  %prec  SIGN 

{ 

$$  =  merge!  "-%s",  52  ); 

) 

I 

RW_NOT  expression  %prec  RW_NOT 

( 

$S  =  merge!  ".NOT.  %s" ,  52  ); 


executable  statement : 

do_statemer.t 

I 

logicaI_i f_statement 
I 

block  if_statement 
I 

else  statement 
I 

else  if_statement 
I 

end_i f_statement 
I 

subset  executable  statement 


do_statement : 

RW_DO  optional_integer  IDENTIFIER  ' - '  expression 


optional  integer: 

/"*  NULL  */ 

( 

55  -  0; 

1 

1 

INTEGER 

( 

55  =  51; 

) 


logical_i f_s lavement : 

i  f_expression  subset _execu table  state me nt 


if  expression: 

RW_IF  ’ ('  expression  ') ' 


block  i  f  _st atemen-t  : 

RW_IF  ' ('  expression  ') '  RW_THEN 


else  statement: 

RW  ELSE 


else  if  statement: 

RW  ELSE  IF  1  express:  or.  '  ;  1  RW  !’::EN 


list 


end  if  statement: 
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RW  END  IF 


subset_executable_statement : 

ass ignment_st a tement 

I 

assign_statement 

I 

arithmet ic_i f_statement 
I 

continue_st a tement 
I 

call_st a tement 
I 

return_stacement 

uncondicianal_go_co_st a cement 

I 

computed_go_to_st a tement 
I 

assigned_go_to_statement 

I 

stop_statement 

I 

pause_statement 

I 

io  statement 


assignment_  statement : 

variable  expression 


assign_statement : 

RW  ASSIGN  INTEGER  RW  TO  IDENTIFIER 


arithmetic_i f_stateraent : 

RW _ TF  '('  expression  ')'  integer_list 


ccntinue_statement : 

RW  CONTINUE 


call  statement: 

RW_CALL  IDENTIFIER 

RW_CALL  IDENTIFIER  opt ional _actual_argument_l i st 


optional  actual_a rgument_l ist : 

'  ('  ‘ >  ’ 

( 

$$  =  0; 

1 

I 

'('  actual_argument_list  ')' 

( 

SS  =  $2; 

} 


actua la rgument_l ist: 

actual_argument 

1 

S$  -  merge!  "{%st“.  Si  ); 

) 

act  ua  l_a  rgument  _1  l  st  actual_argi:ment 

( 

SS  =  merge!  ”%s(%s)”,  SI,  S3  ); 

) 
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actual _argument : 

expression 

( 

$$  =  SI; 

I 

I 

actual_argument_al ternate_return 

{ 

$$  =  SI; 

1 


act ua i_argument_a 1 ternate_re turn ; 
INTEGER 

{ 

$$  =  merge (  "*%sn,  S2  ) ; 

1 


return_statement : 

RW_RETURN  optional_expression 


unconditional_go_to_statement : 
RW  GO  TO  INTEGER 


computed_go_to_statement : 

RW_GO_TO  '('  integer_list  ')'  opc iona L_comma  expression 


assigned_go  to_stacement : 

RW__GO  TO  IDENTIFIER 

I 

RW_GO_TO  IDENTIFIER  optional _comma  '(‘  integer_list  ’)' 


optional  comma: 

f*  NULL  */ 


integer_l ist : 

INTEGER 

{ 

$S  =  merge (  "{%s}" ,  $1  ); 

} 

t 

integer_list  INTEGER 

{ 

$  $  =  me rge  <  " % s { % s } M ,  SI,  S3  ); 

} 


pause^statement : 

RW_PAUSE  opt ional_express ion 


stop_st  a tement : 

RW_STOP  opt ional_expression 


io_statement : 

open_st  a  t  erner.t 


i 


close  statement 
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inqui re_st a cement 
I 

read_statement 

I 

write_statement 

I 

print_statement 

I 

backspace_statement 

I 

rewind_statement 

I 

endfile  statement 


open_statement : 

RW  OPEN  '('  control  information  list  ' )' 


close_statement : 

RW  CLOSE  '('  control  information  list  ')' 


inqui re_statement : 

RW  INQUIRE  '('  control  information_list  •)' 


read_statement : 

RW_READ  '('  control_information_list  optional_io_list 

I 

RW_READ  control 
I 

RW_READ  control  io_list 


w ri te_statement : 

RW_WRITE  ■('  control_information_list  ' )'  optional_io_list 


print_statement : 

RW_PRINT  control 

I 

RW  PRINT  control  io_list 


backspace_statemeut : 

RW_BACKSPACE  '(’  cont rol_inf ormat ion_l i st  ')' 

I 

RW  BACKSPACE  control 


rewind_statement : 

RW_REWIND  '('  control_information_list  ')' 

t 

RW  REWIND  control 


endfile_statement: 

RW_ENDFILE  '('  cont rol_in forma t ion_l ist 
I 

RW  ENDFILE  control 


cont  rol_in  format ion_l  ist: 

cont rol_in format  ion 
( 

SS  =  merge (  ” (%s)",  SI  ); 

) 

control  in  format i on_l i st  rnnr rcl  inloimati^n 

f 
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SS  =  merge)  "%s(%s)",  $1,  S3  ); 

> 


cont  rol__inf  ormat  ion : 
control 
( 

$$  =  $1; 

1 

IDENTIFIER  '=■  control 

{ 

$S  =*  merge)  "%s  =  %s",  SI,  S3  !; 

> 


control : 

variable 

1 

SS  =  SI; 

) 

I 

constant 

( 

$$  =  SI; 

} 

I 

( 

SS  =  duplicate)  "*"  ); 

1 


optional  io_list: 

/*  NULL  */ 

( 

SS  =  0; 

1 

I 

io_list 

( 

SS  =  SI; 

1 


io  list: 

io 

( 

SS  =  merge (  " ( %s> ",  $1  ) ; 

) 

io_list  ' , '  io 

( 

SS  =  merge)  "%s(%s(",  $1,  S3  >; 

1 


expression 

( 

SS  =  SI; 

) 

; o_imolied_do_li st 

( 

SS  =  SI; 

1 


io_impl ied_do_l i st : 

'('  io_list  11  IDENTIFTFR  '='  express ion_l ist  ' ) ' 

/ 

SS  =  merge)  "(  %s,  %s  =  %s  list)  52,  ",  "  ),  54,  list)  $6,  ",  "  )  )  ; 

) 


i 
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format_statement : 

RW  FORMAT 


%% 


FILE:  equivalence / include / I ist . h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Engineering  Research  Laboratory 

*  Author:  Stepnen  R.  Wachtel 

'/ 


♦define  LIST  struct  list_type 
LIST 

( 

char  'identifier; 
char  'alternate; 
int  usage; 

LIST  'next; 

); 


extern  LIST 
extern  LIST 
extern  LIST 
extern  void 
extern  LIST 
extern  void 
extern  void 


*end_list(  ); 
*add_list(  ); 

•f ind_iist (  )  ; 
usage_list(  ); 
*find_index(  ); 
print_llsc(  ); 
delete  list)  ); 


FILE :  equivalence/1 ibrary /Makefile 


* 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

(t  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


CC  =  cc  -g 
INCLUDE  =  . . /include 
CFLAGS  =  -IS (INCLUDE) 
LIBRARY  =  library. a 


OBJECTS  -  \ 
count. o  \ 
duplicate . o 
hoi lerith . o 
link_l ist . o 
list . o  \ 
main.o  \ 
merge.o  \ 
non_blank . o 
parse. o  \ 
repl icate . o 
type.o  \ 
uppercase . o 
yyerror.o  \ 
yygetc.o  \ 
yywrap. o 


\ 

\ 

\ 


\ 

\ 

\ 


S (LIBRARY)  :  S  (OBJECTS) 

ar  crv  S  Licr..\'-;  s  (OBJECTS) 
ranlib  S (LIBRARY) 


■SUFFIXES:  .c  .o 
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.  c  .  o  : 

$(CC)  -c  S(CFLAGS)  $< 


clean : 

rm  -f  $ (LIBRARY)  $ (OBJECTS) 


FILE:  equiva  l.ence/ library /count .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


int  count (  string,  length,  c  ) 
register  char  "string; 
register  int  length; 
register  char  c; 

{ 

register  int  c_count  =  0; 

while  (  length  !=  0  ) 

( 

if  (  "string  ==  c  ) 
c_count"t; 

string++; 

length — ; 

) 

return (  c_count  ) ; 

)  /*  count  */ 


FILE:  equivalence /library /duplicate . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 
((include  <string.h> 
((include  <malloc.h> 


char  "duplicate)  string  ) 
register  char  "string; 
t 

register  char  "temporary  =  (char  "(NULL; 

if  (  string  !=  (char  *)NULL  ) 

( 

if  (  (  temporary  =  (char  *)malloc(  strlen(  string  )  +  1  )  ,  !=  (char 

strcpy(  temporary,  string  ); 

else 

fprintfl  stderr,  "ERROR:  duplicate)  %s  )\n”,  string  ); 

1 

return)  temporary  ); 

(  /*  duplicate  */ 


FILE :  equivalence/ 1 ibrary /hoi le r  1  in . c 


/* 

*  Copyright  1991 

*  Georgia  i nst i t C °  of  Technology 

*  "cr.puter  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


* )  NULL  ) 
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♦include  <stdio.h> 


char  'hollerithl  string,  delimeter  ) 
register  char  'string; 
register  char  delimeter; 

( 

int  hollerith_length; 

register  int  string_length  =  0; 

sscanf (  string,  "%dh",  shol lerith_length  ); 

string [  string_length++  !  =  delimeter; 

while  (  hoi le ri th_length  !=  0  ) 

if  (  (  string!  string  length  1  =  yvinoutl  )  )  ==  '\n'  ) 

{ 

yyunput (  string!  string_length  ]  ); 
break; 

1 

st ring_length++; 
hollerith_length--; 

} 

string!  string_length++  )  =  delimeter; 

string!  string_length  1  =  '\0'; 

return!  string  ); 

)  /*  hollerith  */ 


FILE :  equivalence/ library /I ink_l ist . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  <malloc.h> 
♦include  "list.h" 


extern  FILE  'yyin; 
extern  FILE  'yyout; 
extern  char  'merge (  ) ; 


LIST  *end_list(  list  ) 
register  LIST  'list; 

( 

if  (  list  ! =  (LIST  ' ) NULL  ) 

/ 

while  (  list->next  !=  (LIST  ' ) NULL  ) 
list  =  list->next; 

} 


return  (  list  ) ; 
)  /*  end  list  */ 


LIST  *add_list(  list,  common_name,  identifier  ) 
register  LIST  "list; 
register  char  'common_name; 
register  char  'identifier; 

( 

register  LrST  'temporary  =  (LIST  *)malloc(  sizeof (  LIST  )  ); 

if  (  common_name  ==  (char  '(NULL  ) 

{ 

tempora ry->ident i f ier  =  identifier; 
temporarv->alternate  =  (char  '!!'r|LL; 

1 

else 
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( 

temporary->  idem,  i  f  r  =  identifier; 

Cemporary->alternate  =  merge!  "%s.%s",  common_name,  identifier  j, 

} 

temporary->usage  =  0; 
temporary->next  =  (LIST  *)NULL; 

if  (  'list  ==  (LIST  * ) NULL  ) 

•list  =  temporary; 

else 

end_list(  *list  ) ->next  =  temporary; 

return!  temporary  ); 

)  /*  add_list  */ 


LIST  *find_list(  list,  identifier  ) 
register  LIST  'list; 
register  char  'identifier; 

< 

while  (  list  !=  (LIST  *)NULL  ) 

( 

if  (  strcmpl  list->identif ier,  identifier  )  ==  0  ) 
return (  list  ) ; 

list  =  list->next; 

} 

return (  (LIST  'JNULL  ); 

1  / *  find  list  */ 


void  usage_list(  list,  identifier  ) 
register  LIST  'list; 
register  char  *identifier; 

( 

register  LIST  'temporary; 

if  (  (  temporary  find_list(  list,  identifier  )  )  !=  (LIST  * ) NULL  ) 
temporary->usage++; 

)  /*  usage_list  */ 


LIST  *f  ind_ir,dex  (  list,  index  ) 
register  LIST  ‘list; 
register  int  index; 

f 

while  (  list  !=  (LIST  *)NULL  ) 

! 

if  (  --index  ==  0  ) 
return (  list  ) ; 

list  =  list->next; 

) 

return  (  (LIST  *) NULL  )  ; 

)  /*  find  index  */ 


void  print_list(  list,  name  ) 
register  LIST  'list; 
register  char  'name; 

( 

while  (  list  !=  (LIST  *)NULL  ) 
f 

fprintfl  yyout,  "d (\"UU%s .FOR\" , \”%s\M , \“%s\", »d) \n",  name,  list->ident 
1 ist->al ternate,  list->usage  ); 

list  =  list->next; 

I 

)  /*  print_list  */ 


void  delete_l 1st (  list  ) 
register  LIST  *list; 

! 

if  <  list  :=  (LIST  * } NULL  ) 

! 

delete  list(  list->next  ); 
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free (  list  ) ; 

} 

(  /’  delete  list  * ' 


FILE:  equi valence/ 1 iora ry/ 1 i st . c 


/’ 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 


*  Computer 

Engineering 

Research  Laboratory 

*  Author: 

V 

Stephen  R. 

Wacntel 

extern  char 

’parse  (  ) ; 

extern  char 

•merge (  ) ; 

char  *  list  ( 

input  list. 

delimeter  ) 

register  char  *input_list; 
register  char  ’delimeter; 

f 

register  char  • output_l i st ; 
register  char  ’list; 
register  char  'temporary; 

output_list  =  parse!  input_list  ); 
list  =  parse!  input_list  ); 

while  (  list  !-  (char  *)0  ) 

( 

temporary  =  merge!  "iststs",  output_list,  delimeter,  list  ); 

free!  output_list  ); 
free  (  list  ) ; 

output_list  =  temporary; 
list  =  parse!  input_list  ); 

) 

return!  output_list  ); 

)  /*  list  */ 


FILE:  equivalence/1 ibrary/main .  c 


/* 

'  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 


extern  FILE  *yyin; 
extern  FILE  ’yyout; 


♦define  PROGRAM  argument!  0  I 
♦define  INPUT_FILE  argument!  I  i 
♦define  OUTPUT_FILE  argument!  2  1 

int  main!  number_argument,  argument  ) 
int  number_argument; 
char  ’argument!  j; 

! 

if  (  number  argument  ==  1  ! 

( 

yyin  =  stdin; 
yyout  =  stdout; 
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yy parse!  ); 
exit!  0  )  ; 
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if  (  number_argument  ==  3  ) 

i 

if  (  (  yy in  =  fopen  (  INPUT_FILE,  "r”  )  )  (FILL  *)NL'LL  I 

{ 

fprintfl  stderr,  "%s:  ERROR  -  ur.aoie  to  open  input  file  ‘%s'\n",  PROGRAM, 
INPUT_FILE  )  ; 

exit (  -1  )  ; 

) 

if  (  (  yyout  =  fopen (  OLTPUT_FILE,  "w"  )  )  = =  (FILE  *)NULL  ) 

( 

fprintfl  stderr,  "%s:  ERROR  -  unable  to  open  output  file  '%s'\n",  PROGRAM, 
OUTPUT_FILE  ) ; 

exit (  -1  )  ; 


yyparse (  ) ; 
exit  (  C  )  ; 

} 

fprintfl  stderr,  "usage:  %s  <i.nput  fiie>  <output  fiie>\n“,  PROGRAM  ); 
ex i t (  0  )  ; 

!  /  *  main  *  / 


FILE :  equivalence/ 1 ibrary /me rge .  c 


/’ 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  <malloc.h> 


♦  define  STRLEN  (  s  )  (  strienl  s  )  -  2  ) 


char  ‘merge!  string,  a,  b,  c,  d  ) 

register  char  ‘string; 

register  char  *a; 

register  char  *b; 

register  char  ‘c; 

register  char  ‘d; 

I 

register  char  ‘temporary  =  (char  *)N'JLL; 

switch  (  count!  string,  strienl  string  ),  '%'  )  ) 

f 

case  0: 

if  (  (  temporary  =  (char  *)malloc(  strienl  string  )  +  1  )  )  !=  (char  *)N’JLL  ) 

sprintf(  temporary,  string  ); 

else 

fprintfl  stderr,  "ERROR:  merge (  %s  )\n",  string  ); 

break; 

case  1 : 

if  (  (  temporary  =  (char  *)maiioc(  strienl  string  )  +  STRLEN (  a  )  *  1  )  i 

(char  * ) NULL  ) 

sprintf(  temporary,  string,  a  )  ; 

else 

fprintfl  stderr,  "ERROR:  merge!  %s,  %s  )\n",  string,  a  ) ; 

break ; 

case  2: 

if  (  (  temporary  =  (char  *)ma]loc(  strienl  string  )  +  STRLEN!  a  )  *  STRLEN!  b 

)  *  1  )  )  ! -  (char  ‘ ) NULL  ) 

sprintfl  temporary,  string,  a,  b  ); 

e  1  sc 

fprintfl  stderr,  "ERROR:  merge!  %s,  %s,  %s  )\n",  string,  a,  b  ); 

break; 

case  3: 

if  (  (  temporary  =  (char  *!maiioc(  strlen(  string  )  *  STRLEN!  a  )  -  STRLEN!  b 
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)  +  STRLEN  (  c  )  +  1  )  )  :«  (char  'JN'JLL  ) 

sprintfl  tempora.y,  siring,  a,  o,  c  ); 

fci  se 

fprintf!  stderr,  "ERROR:  merge!  is,  %s,  %s,  %s  )\r.”,  sir 

break; 

case  4 : 

if  (  (  temporary  -  (char  ’Inalioc!  strienl  string  )  +  STRLEt 

)  ♦  STRLENI  c  )  +  STRLEN  (  d  )  »  i  )  1  (char  '(NULL  ) 
sprint f(  temporary,  string,  a,  e,  c,  d  ); 

else 

fprintf  (  stderr,  "ERROR:  merge  (  %s,  %s.  %s,  %s,  %s  )\n", 

)  ; 

break; 

default: 

fprintf  (  stderr,  "ERROR:  merge)  %s  )\.r",  string  ); 
break; 

) 

return!  temporary  ); 

)  /*  merge  */ 


FILE:  equ  i  vaien.ee/ 1  ibrary /non_biank  .  c 


/' 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


iinciude  <string.h> 


char  *non_blank(  string  ) 
register  char  'string; 

! 

register  int  offset; 
register  int  length; 

length  =  strienl  string  )  -  1; 

while  (  (  string;  length  I  ==  •  1  )  ss  (  st'ingl  length  ]  :=  '\0*  ) 
string;  length--  ]  »  • \ 0 ' ; 

offset  «  0; 

while  (  (  string!  offset  ]=='')  41  (  string)  offset  ]  !=  '  \ 3 '  ) 
string!  offset-*-*  1  »  '  \  0 '  ; 

strepyl  string,  sstringl  offset  )  ); 

if  (  strienl  string  )  !-  9  ) 

return  i  string  ) ; 

else 

return  I  0  ) ; 
i  /  *  nor.  blank  *  / 


FILE:  equivalence/library/parse.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


^include  <string.h> 


extern  char  'duplicate!  ); 


char  'parse (  list  I 
register  char  'list 


ir.g,  a,  b,  c  )  ; 


via)  -  STRLENI  b 


string,  a,  b. 


) 


) 
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register  inc  length  =  0; 

register  int  brace  =  0; 

register  char  * temporary  -  (char  *)0; 

for  { ; ; } 

{ 

switch  (  list(  length  ;  ) 

case  ' [ ' : 

brace  rt; 
break; 

case  ' } ' : 
bract 
break; 


if  (  bnce  ==  0  ) 
break; 

length++; 


if  (  le-gth  . 

iist[  length  ]  =  '\0'; 

temporary  =  duplicate (  list  *  1  ); 

strcpy!  list,  list  +  1  +  length  ); 

\ 

else 

{ 

if  (  list[  length  ]  !=  '\0'  ) 

{ 

temporary  =  duplicate(  List  ); 
1 1  st  [  length  ]  -  '  \0  V- 

} 


return!  temporary  >; 
}  / *  parse  */ 


FILE:  equivalence/ library /replicate. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 

*  / 


4  include  <string.h> 
# include  <maiioc.h> 


char  *replicate<  count,  string,  delimeter  ) 
register  int;  count; 
register  char  *  string; 
register  char  *deli. meter; 

{ 

register  iar  ^temporary  =  (char  *;:r.alioc(  (  count  *  strlen  (  string  )>-»•({  coun 
1  )  *  strlen(  delimeter  )  )  +  1  ); 

if  (  temporary  ’=  (char  *)0  ) 

/ 

strcpy(  temporary,  string  ); 

while  (  --count  !=  0  ) 

( 

strcat (  temporary,  delimeter  ); 
strcat (  temporary,  string  ); 

) 

) 


return!  temporary  ); 

'»  / *  rop^icate  *  / 

F  I  LF. :  equ  i  va  lence/  i  ih  ra  ry  /t  y  pe  .  c 
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/* 

*  Copyright  1991 

’  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  char  'merge!  ); 


char  'type!  type_name,  opticnal_type_length  ) 

register  char  *type_name; 

register  char  *optional_type_length; 

{ 

if  (  optional_type_lenqth  !=  0  ) 

return!  merge!  "%s%s",  cype_name,  optionaI_type_lengch  )  ); 

else 

return!  type_name  ); 

)  /*  type  '/ 


FILE :  equi valence/ 1 ibrary /uppercase. c 


/' 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Engineering  Research  Laboratory 
'  Author:  Stephen  R.  Wachtel 

'/ 


char  'uppercase!  string  ) 
register  char  'string; 

( 

register  int  index  =  0; 

while  (  string!  index  ]  !=  '\0'  ) 

{ 

string!  index  ]  «  toupper!  string!  index  ]  ); 

index"; 

) 

return (  string  )  ; 

}  /•  uppercase  */ 


FILE:  equ ivalence /libra ry/yyerror.c 


/' 

'  Copyright  1991 

'  Georgia  Institute  of  Technology 
*  Computer  Engineering  Research  Laooratcry 
'  Author:  Stephen  R.  Wachtel 

'/ 


I  include  <stdio.h> 


extern  int  yylineno; 


void  yyerror!  string  ) 
register  char  'string; 

fpri.ntf!  stderr,  "line  %d,  %s\n"/  yylineno,  string  ); 

exit!  -1  ) ; 
i  /'  yyerror  */ 


F I LE :  equ i va 1 ence / 1 i D  r a  ry /y yge t c . c 


'  Copyright  1991 


/ 
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*  Georgia  Institute  o £  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦  include  -retype. h> 


extern  int  yylineno; 


int  tab(  length  ) 
register  int  length; 

while  (  length —  !=  0  ) 
yyunput (  '  '  ) ; 

return (  '  ' 

1  /*  tab  »/ 


int  yygetef  file  ) 
register  FILE  ‘file; 

( 

int  c; 

int  column!  6  ]; 
loop: 

if  (  (  c  =  getc!  file  )  )  ==  ' \t '  ) 
c  =  tab (  6  ) ; 

if  (  c  ! =  ' \n*  ) 
return (  c  )  ; 


if 

(  (  column!  0  ]  * 

goto  abort  0; 

getc  ( 

file  )  )  !=  * 

*  ) 

if 

(  (  column!  1  )  = 
goto  abort_l; 

getc  ( 

file  )  )  !=  1 

‘  ) 

if 

(  (  column  [~  2  ]  = 
goto  abort_2; 

getc  ( 

file  )  )  !=  * 

*  ) 

if 

(  (  column!  3  ]  = 
goto  abort_3; 

getc  ( 

file  )  )  !=  ’ 

•  ) 

if 

(  (  column!  4  J  = 
goto  abort  A; 

getc  ( 

file  )  )  !=  1 

•  > 

if 

(  isspace!  column 

5  1 

=  getc!  file  ) 

>  ) 

goto  abort_5; 


•  yy lineno++; 
goto  loop; 

abort_5 : 

if  (  column!  5  J  ==  '\t'  ) 
cab (  1  )  ; 

else 

( 

yyunput (  column!  5  ]  ); 
if  (  column!  5  1  ==  '\n*  ) 
yylineno++; 

1 


abort_4 : 

if  (  column!  4  1  =>=  '\t'  ) 
tab(  2  )  ; 

else 

! 

yyunput!  column!  4  ]  ); 
if  (  column!  A  1  ==■  •  \n'  ) 
yylineno++; 

I 


abort_3 : 

if  (  column!  3  ]  —  '\t'  ) 
tab!  3  ) ; 

else 

! 

yyunput!  column!  3  ]  ) ; 

if  (  column!  3  1  ==  '\n*  ) 
yy 1 i neno* + ; 

) 
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abort_2 : 

if  (  column!  2  1  ==  1 \t '  ) 
tab  !  4  ) , 

else 

( 

yyunput (  column!  21  ); 

if  (  column!  2  )  ==  '\n'  ) 
yylineno++; 

} 

abort_l : 

if  (  column!  1  1  ==  '\t'  ) 
t  ab (  5  )  ; 
else 

{ 

yyunput!  column!  1  1  ); 
if  (  column!  1  1  ==  '\n'  ) 
yylineno-^+j 

) 


abort_0 : 

if  (  column!  0  J  ==  '\t'  ) 
tab (  6  ) ; 
else 
( 

yyunput!  column!  0  1); 
if  (  column!  0  1  ==  '\n'  ) 
yylineno++; 

> 

return (  c  )  ; 

1  /*  yygetc  */ 


FILE;  equivalence/ libra ry/yy wrap,  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


int  yywrap!  ) 

( 

return (  1  ) ; 
}  /*  yywrap  */ 


FILE:  equivalence/scanner. 1 


*  ' 

/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


%a 

10000 

%e 

10000 

%k 

10000 

%n 

10000 

%o 

10000 

%p 

10000 

a 

(a«j 

b 

(bB) 

c 

[CC] 

d 

(dO  1 

e 

(eE| 

f 

ifF) 

g 

!gG] 

h 

[hHI 
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i 

[ill 

j 

[  jJl 

k 

CkKl 

1 

[1L1 

m 

[mM] 

n 

(nNl 

o 

[00] 

P 

tpP] 

q 

[qQl 

r 

[  rR  1 

s 

[sSl 

t 

[tT] 

u 

[uUl 

V 

[W1 

w 

[wW) 

X 

[xX] 

y 

[yYl 

z 

[zZl 

%( 

((include  "grammar. h" 
extern  char  'yylval; 


Kundef  YYLMAX 
((define  YYLMAX  (256*20) 


extern  char  'duplicate (  ); 
extern  char  *hollerith(  ); 
extern  char  *non_blank(  ); 
extern  char  'uppercase (  ); 

*1 


%% 


A [\*cC] . ' C \ n ]  | 

~l\  1  *  C  \n  ]  ( 

# ifdef  DEBUG 
ECHO; 

#endi f 

yylval  =  duplicate!  yytext  ); 
return (  COMMENT  ) ; 

) 


r\  i  ( 

# ifdef  DEBUG 
ECHO; 

#endi f 

/*  return!  •  \  •  )  '/; 

) 


[\&!  ( 

# ifdef  DEBUG 
ECHO; 

(tendi  f 

return (  • \s •  ) ; 

1 


t\  (1  ( 

# ifdef  DEBUG 
ECHO; 

#endi  f 

return (  ■ \ ( *  ) ; 

( 


[\>  )  ! 
lifdef  DEBUG 
ECHO; 
(tendif 

1 


return  (  ■  \)  ’  )  ; 
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[\*1  f 

Iifdef  DEBUG 
ECHO; 
lendif 

return  (  1 \*  1  )  ; 

1 


[\*)[\*1  < 

Iifdef  DEBUG 
ECHO; 

#endi  f 

return (  EXPONENTIATE  ); 

1 


t\+;  i 
Iifdef  DEBUG 
ECHO; 
lend! f 

return  (  ' \+ '  )  ; 

1 


C\,  1  { 

Iifdef  DEBUG 
ECHO; 
lendif 

return  (  '  \,  '  )  ; 

) 


:\-i  ( 

Iifdef  DEBUG 
ECHO; 
lendi f 

return  (  ' '  )  ; 

1 


r\-j  ( 

Iifdef  DEBUG 
ECHO; 
lendif 

return (  ' \ '  ) ; 

} 


[\/l  ( 

Iifdef  DEBUG 
ECHO; 
lendi f 

return  (  ' \/  •  ) ; 

) 


C  \  :  1  ( 

Iifdef  DEBUG 
ECHO; 
lendi f 

return  (  ■  \  :  '  )  ; 

) 


[\  =  1  ( 

Iifdef  DEBUG 
ECHO; 
lendif 

return  (  • \=  '  ) ; 

) 


[\n]  f 
Iifdef  DEBUG 
ECHO; 
lendi f 

/*  return!  '\n'  )  */; 

) 


E \t  1 


( 
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#ifdef  DEBUG 
ECHO; 

#endif 

/*  return!  '\t'  )  */; 

) 


[\ • 1  fall n) (d) [\ . 1  { 

ftifdef  DEBUG 
ECHO; 
fendif 

return  (  RW_AND  ); 

) 


C\-lfei{q)t\.l  ( 

*ifdef  DEBUG 
ECHO; 

Kendif 

return (  RW_EQ  ) ; 

} 


[\*)fe){q}(v}[\.]  ( 

tifdef  DEBUG 
ECHO; 

#endif 

return (  RW_EQV  ) ; 

1 


[\ - )  (fKal(l)lsKel  (\.)  ( 

#i fdef  DEBUG 
ECHO; 

#endi  f 

return!  RW_FALSE  ); 

) 


[\.Hql  {«}  C\.J  ( 

#ifdef  DEBUG 
ECHO; 

#endi f 

return (  RW_GE  ) ; 

) 


f\.i(q!{t) [\.J  ( 

#i fdef  DEBUG 
ECHO; 

#endif 

return!  RW_GT  ); 

) 


[\.)(lHeK\.l  f 
# i fdef  DEBUG 
ECHO; 

Kendi f 

return!  RW_LE  ); 

) 


[\.m>(t> r\.)  ( 

#i fdef  DEBUG 
ECHO; 
ilendi  f 

return!  RW_LT  ); 

1 


[\.l (nl(el(\.l  { 

#ifdef  DEBUG 
ECHO; 

#endi f 

return!  RW_NE  ); 

1 


(\.l  |nKel(qllv|[\.|  ( 
t i fdef  DEBUG 
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ECHO; 

#endi  f 

return  (  RW_NEQV  ) ; 

1 


[\. 1 {nl (ol (t) (\. ]  { 

# i fdef  DEBUG 
ECHO; 
ftendi  f 

return (  RW_N0T  ); 

1 


[\. 1 (o) ( r >  t \ - 1  { 

#i fdef  DEBUG 
ECHO; 

#endi  f 

return (  RW_0R  ) ; 

1 


[\.] {t)(r)(u)(e: [\.l  ( 

#i fdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_TRUE  ) ; 

) 


(a)(s) (s) { i ) {g} (n)  { 

#i fdef  DEBUG 
ECHO; 

#endi f 

return (  RW_ASSIGN  ); 

) 


(b)  {aHc}(M  (sHp)UHc)  (e)  { 

#ifdef  DEBUG 
ECHO; 

Kendif 

return (  RWBACKSPACE  ); 

) 


(b)(l)|o)(c){lt|  [\  IMdHal(tHa)  < 
#i fdef  DEBUG 
ECHO; 

#endi f 

return (  RW_BLOCK_DATA  ) ; 

1 


(cMaMIMl)  { 
itifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_CALL  ); 

1 


(cHhl(al(rMa)lcl(tl(eHr)  1 
#i fdef  DEBUG 
ECHO; 

(tendi  f 

return (  RW_CHARACTER  ) ; 

) 


(0(1)  (o)  (s)(e)  ( 

Klfdef  DEBUG 
ECHO; 

*endi f 

return)  RW_CLOSE  ); 

) 


|c)|o)|ir.)(m||o)|n)  ( 
# i fdef  DEBUG 
ECHO; 
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tendi f 
) 


return  (  RW  COMMON  ) ; 


(cHoKnHpHlIleHxl  i 
tifdef  DEBUG 
ECHO; 
tendif 

return  (  RW_COMPLEX  ) ; 

) 


(cHolInKtHillnHuKel  ( 
#ifdef  DEBUG 
ECHO; 
tendi f 

return!  RW_CONTINUE  ); 

) 


(d> ( at ( t )  ( a)  ( 

#ifdef  DEBUG 
ECHO; 
tendif 

return!  RW_DATA  ); 

) 


{dt(it(mt(e)(n|(s)lit{ot{nf  { 
tifdef  DEBUG 
ECHO; 
tendi f 

return!  RW_DIMENSION  ); 

) 


(dHo)  ( 

(tifdef  DEBUG 
ECHO; 

#endi f 

return (  RW_DO  ) ; 

t 


(d>  (o)  (ullbHU  (e)[\  IMpHrHeHclIillsIliHoHn)  1 
#i fdef  DEBUG 
ECHO; 
tendi f 

return  (  RW_DOUBLE_PRECISION  ) ; 

I 


(eKll(sHe)  { 

#i fdef  DEBUG 
ECHO; 

#endif 

return!  RW_ELSL  ); 

t 


(eHIHs)  (e)  (\  ]  *  !  i  )  {  f }  { 

#i fdef  DEBUG 
ECHO; 

#endi f 

return (  RW_ELSE_IF  ) ; 

) 


(e)fnHd}  { 

#ifdef  DEBUG 
ECHO; 
fendi  f 

return (  RW_END  ) ; 

t 


(e> (n) (dj [\  ) *(i ) ( f }  { 

tifdef  DEBUG 
ECHO; 
tendi f 
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return (  RW_END_IF  ); 

1 


(eHaHdHfKilU)le)  { 

# i fdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_ENDFI LE  ); 

1 


{e} |n(|t> (r)!y)  ( 

lifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_ENTRY  ); 

1 


(e){q)(u}{i)(v){a}{l){e}(n){c}{e)  { 
(tifdef  DEBUG 
ECHO; 

#endif 

return  (  RW_EQUI VALENCE  ); 

1 


(el(x)  (tHe)  f  rUnHaHl)  ( 

#i fdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_EXTERNAL  ); 

1 


{f  1  { o )  {  r }  {m)U)  (t)  .*  < 

Hi fdef  DEBUG 
ECHO; 

#end1 f 

yylval  =  duplicate;  yytext  ); 
return (  RW_FORMAT  ) ; 

1 


(f)(u)(n)(c||tHi)|oHnl  ( 
itifdef  DEBUG 
ECHO; 
lendif 

return;  RW_FUNCTION  ); 

} 


Iqllol [\  l*(t)(o)  ( 

#ifdef  DEBUG 
ECHO; 
lendi f 

return;  RW_GO_TO  ); 

1 


;i)(f)  ( 

#i fdef  DEBUG 
ECHO; 

#endi f 

return;  RW_IF  ); 

1 


( i  Mm)  (p)  { 1 )  (  i }  (c)  f  i  H  t )  ( 

# i fdef  DEBUG 
ECHO; 

#endi f 

return!  RW_IMPLICIT  ); 

) 


(i)(n)(c|(l)(u)(dHe)  { 

lifdef  DEBUG 
ECHO; 

(tendi  f 
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return (  RW_ INCLUDE  ); 

) 


fiHn}(qHu)(i}(r}(e)  ( 
#ifde£  DEBUG 
ECHO; 

#endi f 

return  (  RW_INQUIRE  ); 

) 


(i)(n)(t)(e)(g){e)fr)  { 

# i fdef  DEBUG 
ECHO; 

(tendi  f 

return!  RW_INTEGER  ); 

> 


|i)(n)(t|  IrUillnHslUHcl  ( 
tifdef  DEBUG 
ECHO; 
tendi £ 

return!  RW_INTRINSIC  ); 

} 


('.’!:HgKi!(c|  (a)(1)  ( 

tifdef  DEBUG 
ECHO; 

#endi f 

return (  RW_LOGICAL  ); 

} 


lnHal(m)(e)(lKlHs)(t)  ( 
tifdef  DEBUG 
ECHO; 
itendif 

return!  RW_NAMELIST  ); 

I 


(o)(p)(e)(n)  ( 

#i fdef  DEBUG 
ECHO; 

#endi£ 

return (  RW_OPEN  ) ; 

) 


Ipllallrl (a) (ml (e) (t ) (e) (r)  ( 

(tifdef  DEBUG 
ECHO; 

Itendi  f 

return!  RW_PARAMETER  ); 

) 


( p ) (a) { u  > (s) (e)  ( 

♦i fdef  DEBUG 
ECHO; 

#endi  f 

return!  RW_PAUSE  ); 

) 


(p)(r!(i)(n)(t)  { 

(tifdef  DEBUG 
ECHO; 
lend! f 

return!  RW_PRINT  ); 

) 


(pl|rHo)(q)|rHa)(m)  ( 
tifdef  DEBUG 
ECHO; 
tendi  f 

return!  RW_PROGRAM  ); 
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1 


lr|le|(a)|d)  ( 

(tifdef  DEBUG 
ECHO; 

(tendi f 

return!  RW_READ  ); 

) 


(r)Ie|{a||l)  ( 

#i fdef  DEBUG 
ECHO; 

#endi  f 

return!  RW_REAL  ); 

i 


{  rl (e) ( t ) ( u } ( r 1 { n }  { 

(t i fdef  DEBUG 
ECHO; 

#endi f 

return!  RW_RETURN  ); 

) 


(r)|e)(w)(i)(n)(dl  ( 

(tifdef  DEBUG 
ECHO; 

(tendi  f 

return!  RW_REWIND  ); 

} 


(sHativlle!  ( 

# i fdef  DEBUG 
ECHO; 

Kendif 

return (  RW_SAVE  ) ; 

) 


(sHtHoHp)  ( 

# i fdef  DEBUG 
ECHO; 

#endi f 

return!  RW_STOP  ); 

I 


(sHu)(bHrHo)|ul(t!li)(nKe)  ( 
#i fdef  DEBUG 
ECHO; 

(tendi  f 

return (  RW_SUBROUTINE  ) ; 

) 


(tHhl(e)lnl  { 

# i fdef  DEBUG 
ECHO; 

Kendi  f 

return!  RW_THEN  ); 

) 


( t )  {  o )  { 

I i fdef  DEBUG 
ECHO; 

(tendi  f 

return (  RW_TO  ) ; 

} 


(wl(rHiKttle)  ( 

# i fdef  DEBUG 
ECHO; 

(tendi  f 

return!  RW_WRITE  }; 

) 
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(u)(n)(d|(e)lfKi)|n)!e)|d)  1 

(tifdef  DEBUG 
ECHO; 

Kendi f 

return (  RW_UNDEFINED  ); 

) 


[a-zA-Z] [_a-zA-Z0-9] *  { 

Hi fdef  DEBUG 
ECHO; 

#e  ndi  f 

yylval  =  duplicate!  uppercase!  yytext  )  ); 
return!  IDENTIFIER  ); 

) 


^ [0-9  1 [0-9  ] [0-9  ] [0-9  1 [0-9  ] [\  ]  ( 

#i fdef  DEBUG 
ECHO; 
iendi f 

yylval  =  duplicate!  non_blank(  yytext  )  ); 
return!  LABEL  ); 

1 


[0-9]+  I 

[0-9)+/\. [a-zA-Z]+\.  ( 

#i£de£  DEBUG 
ECHO; 

(fendi  f 

yylval  =  duplicate!  yytext  ); 
return!  INTEGER  ); 

1 


[0-9]  +  \.  [0-91 ' ( [eE]  [\  +  \-l ?[0-9J  +  )  ? 
[0-91 *\. [0-9]+ ( [eE ] [\+\-] ?[0-9]+) ? 
[0-9]  +  (  [eE]  [\  +  \-] ? [0-9] +) ?  ( 

# i fdef  DEBUG 
ECHO; 

#endi  f 

yylval  =  duplicate!  yytext  ); 
return!  REAL  ); 


[0  —  9] +\ .  [0-9]*([dD]  [\  +  \  —  1 ? [0  —  9]  +  >  ? 
[0-9]  *\.  [0-9]  +  (  [dD]  [ \  +  \  —  ]  ?  [ 0  —  9 ]  +• )  ? 
[0- 9]  +  ([dD]  [\  +  \-] ?[0-9]+) ?  ( 

#i fdef  DEBUG 
ECHO; 
ftendi  f 

yylval  =  duplicate!  yytext  ); 
return!  DOUBLE  PRECISION  ); 


\ ' [~\ • } *\ '  I 
\"[*\"1»\"  ( 

# l fdef  DEBUG 
ECHO; 

#endi  f 

yytext [  0  |  =  • \"'; 

yytext [  strlen!  yytext  )  -  1  J  =  ' ; 
yylval  =  duplicate!  yytext  ); 
return!  STRING  ); 

) 


[0-9]  +  [hH]  { 

# i fdef  DEBUG 
ECHO; 

#endi f 

yylval  =  duplicate!  hollerith!  yytext,  'X"1  )  ); 
return!  HOLLERITH  ); 

] 
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FILE:  equ i val ence / sc a cement /Make file 


♦ 

♦  Copyright  1991 

♦  Georgia  Institute  of  Technology 

♦  Computer  Engineering  Research  Laboratory 

♦  Author:  Stephen  R.  Wachtel 

♦ 


CC  =  cc  -g 
INCLUDE  =  . . /include 
CFLAGS  =  -1$ (INCLUDE) 
LI3RARY  -  statement. a 


OBJECTS  =  \ 

data  statement,  o 


S (LIBRARY) : $ (OBJECTS) 
rm  -f  S  (LIBRARY) 
ar  crv  $ (LIBRARY)  S (OBJECTS) 
ranlib  S (LI3RARY) 


.SUFFIXES:  .c  .o 
.  c .  o : 

$<CC>  -c  $ (CFLAGS)  S< 


clean : 

rm  -f  S (LIBRARY)  S (OBJECTS) 


FILE:  equivalence/statement/data_statemer.t.c 


*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

'/ 


♦include  <stdio.h> 
♦include  "list.h" 


extern  LIST  'rlist; 
extern  LIST  'iiist; 
extern  chat  'merge!  ); 
extern  char  'parse!  ); 


void  data_statement (  daca_list  ) 
register  char  'data  list; 


regi ster 

char 

•dat  a ; 

register 

cha  r 

•variable  list; 

regi ster 

cha  r 

*constant_list; 

regi ster 

char 

•variable; 

register 

char 

•constant; 

register 

LIST 

•temporary; 

register 

int 

index; 

while  (  data 

=  pa’-sef  data_li 

( 

va r iable_l i st  =  parse!  data  ) ; 
constant_l i st  =  parse!  data  ) ; 

variable  =  se(  variable  ) i st  )  ; 

if  (  strncmp!  variable,  "1REAL",  5  )  =  -  3  ) 

( 

index  =  0; 

while  (  constant  =  parse!  constant! ; st  )  ) 
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i 

if  t  a  Coif  constant  )  •'  =  0  ) 

l 

if  (  (  temporary  =  find_index(  riist,  ++index  )  )  =  0  ) 

temporary-->aiternate  =  merge  {  "RIN(%s)"/  constant  ); 

else 

printf!  “ERROR:  rlist(%d)  not  found\n",  index  ); 

) 

1 

) 

if  (  strncmp!  variable,  "  1 1 NT " ,  4  )  ==  3  ) 

( 

index  =  0; 

while  (  constant  =  parse!  constant_l ist  )  ) 

( 

if  (  atoi(  constant  )  :=  0  ) 

if  (  (  temporary  =  find_index(  ilist,  index  !  )  t-  0  ) 

temporary->alternate  =  merge!  '‘IIN(%s)",  constant  ); 

else 

printf!  "ERROR:  ilist (%d)  not  found\n",  index  ); 

} 

! 

1 

l 

1  /*  data  statement  */ 
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FILE:  etimer/Makefile 


* 

ft  Copyright  1991 

#  Georgia  Institute  of  technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


default:  etimer 


CC  =  cc  -g 
INCLUDE  =  include 
CFLAGS  =  -IS (INCLUDE) 

LIBRARY  =  statement/statement . a  1 ibrary /I ibrary . a 


OBJECTS  -  \ 

S  (INCLUDE) /grammar. h  \ 
‘grammar. [co]  \ 
♦scanner. [co]  \ 
yy t  race . [ co ]  \ 
y . output 


PROGRAMS  =  \ 
'etimer 


grammar. c:  grammar. y 
yacc  -dv  grammar. y 
mv  y.tab.h  S  ( INCLUDE) /grammar . h 
mv  y.tab.c  grammar. c 


scanner. c:  scanner.! 

lex  -vt  scanner. 1  I  sed  '  s/getc/yyget<~/ •  >scanner 


scanner. o:  scanner. c  S ( INCLUDE) /grammar . h 
S  (CC)  S (CFLAGS)  -c  scanner. c 

grammar. o:  grammar. c 

S (CC)  S (CFLAGS)  -c  grammar. c 

etimer :  grammar . o  scanner. o  S(LIBRARY) 

$(CC)  -o  etimer  grammar. o  scanner. o  S(LIBRARY) 


sgramma r . c : g ramma r . c  yytoken.awk 

awk  -f  yytoken.awk  <grammar.c  >sgrammar.c 

sgrammar.o: sgrammar.c 

$(CC)  S  (CFLAGS)  -c  sgrammar.c 

setimer:  sgrammar.o  scanner. o  S (LIBRARY) 

$(CC)  -o  setimer  sgrammar.o  scanner. o  S (LIBRARY) 


dscanner.c:  scanner. c 

cp  scanner. c  dscanner.c 

dscanner.o:  dscanner.c  $ (INCLUDE) /grammar . h 
$(CC)  S (CFLAGS)  -DDEBUG  -c  dscanner.c 

detimer:  grammar. o  dscanner.o  S (LIBRARY) 

S (CC)  -o  detimer  grammar.o  dscanner.o  S (LIBRARY) 


tgrammar.c: grammar. c 

sed  ' s/yystack : /s  yyt race (yy state );/ '  <grammar.c 


tgrammar.o: tgrammar.c 

$(CC)  S (CFLAGS)  -c  tgrammar.c 


>tgrammar . c 
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tetimer:  tgrammar.o  scanner. o  yytrace.o  $ (LIBRARY) 

$(CC)  -o  tetimer  tgrammar.o  scanner. o  yytrace.o  S (LIBRARY) 


yytrace.c:  grammar. c  yytrace.awk 

awk  -f  yytrace.awk  <y. output  >yytrace.c 

yytrace.o:  yytrace.c 

S  (CC)  $(CFLAGS)  -c  yytrace.c 


clean : 

cd  statement;  make  clean 
cd  library;  make  clean 
rm  -f  $ (PROGRAMS)  S (OBJECTS) 


FILE:  etimer/grammar.y 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


/* 

*  FORTRAN  11 

V 


%token  RW_AND 
%token  RW_ASSIGN 
%token  RW_BACKSPACE 
%token  RW_BLOCK_DATA 
%token  RW_CALL 
♦token  RWCHARACTER 
♦token  RW_CLOSE 
♦token  RW_COMMON 
♦token  RW  COMPLEX 
♦token  RW~CONTINUE 
♦token  RW_DATA 
♦token  RW_DIMENSION 
♦token  RW_DO 

♦token  RW_DOUBLE_PRECISION 

♦token  RW_ELSE 

♦token  RW_ELSE  IF 

♦token  RW_END 

♦token  RW_END_IF 

♦token  RW_ENDFILE 

♦token  RW_ENTRY 

♦token  RW_EQ 

♦token  RW_EQUI VALENCE 

♦token  RW_EQV 

♦token  RW_EXTERNAL 

♦token  RW_FALSE 

♦token  RW_FORMAT 

♦token  RW_FUNCTION 

♦token  RW_GE 

♦token  RW_GO_TO 

♦token  RW_GT 

♦token  RW_IF 

♦token  RW_IMPLICIT 

♦token  RW_INCLUDE 

♦token  RW_INQUIRE 

♦token  RW_INTEGER 

♦token  RW_INTRINSIC 

♦token  RW_LE 

♦token  RW_LOGICAL 

♦token  RW_LT 

♦token  RW_NAMELIST 

♦token  RW_NE 

♦token  RW_NEQV 

♦token  RW_NOT 

♦token  RW_OPEN 

♦token  RW_OR 

♦token  RW_PARAMETER 

♦token  RW_PAUSE 

♦token  RW  TRINT 
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♦token  RW_PROGRAM 
Itoken  RW_READ 
♦token  RW_REAL 
♦token  RW_RETURN 
%token  RW_REWIND 
♦token  RW_SAVE 
%token  RW_oTOP 
%token  RW_SUBROUTINE 
%token  RW_THEN 
%token  RW_TO 
%token  RW_TRUE 
%token  RW_WRITE 
%token  RW  UNDEFINED 


%token  COMMENT 
%token  CONCATENATE 
Itoken  DOUBLE_?RECISION 
%token  EXPONENTIATE 
»token  HOLLERITH 
%token  IDENTIFIER 
%token  INTEGER 
%token  LABEL 
%token  REAL 
♦token  STRING 


%lef t 

♦nonassoc  ' :  ' 

%right 

♦left  RW_EQV  RW_NEQV 
♦left  RW_OR 
♦left  RW_AND 
♦left  RW_NOT 

♦nonassoc  RWEQ  RW_NE  RW_LT  RW_LE  RW_GT  RW_GE 
♦left  CONCATENATE 
♦left  ■+• 

♦left  •/' 

♦right  EXPONENTIATE 
♦left  SIGN 


♦  ( 

typedef  char  ’POINTER; 
♦define  YYSTYPE  POINTER 


extern  POINTER 
extern  POINTER 
extern  POINTER 
extern  POINTER 
extern  POINTER 
extern  POINTER 
extern  POINTER 
♦  > 


array  (  )  ; 
duplicate!  ); 
implied_do_list  ( 
label  (  T; 
list!  )  ; 
merge (  )  ; 
type (  ) ; 


)  ; 


♦  ♦ 


program: 

optional_statement_list 

( 

summary (  ) ; 

) 


optional  statement_list : 
/"*  NULL  */ 

I 

statement  list 


statement_l ist : 

statement 

I 

statement  list  statement 
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statement : 

comment _statement 

I 

label  unlabeled_statement 

( 

statement (  $1  ); 

1 


comment_statement : 

COMMENT 

i 

if  (  timert  $1  )  ==  0  ) 

( 

comment  statement {  $1  )  ; 


label: 

LABEL 

{ 

$5  =  label (  $1  ) ; 

1 


unlabeled_statement : 

include_staf ement 
I 

pro, jam_statement 
I 

block_data_s tat ement 
I 

function_statement 

I 

subroutine_statement 

I 

entry_statement 

I 

end_statement 

specif ication_s tat ement 
I 

executable_statement 

I 

format  statement 


include_statement : 

RW_INCLUDE  character_constant 

( 

include_statement (  S2  )  ; 

I 


program _ statement : 

RW_PROGRAM  program_ident i f ier 

( 

program)  32  ); 
program_statement (  $2  ) ; 

) 


program_identif ier : 

IDENTIFIER 

( 

S3  =  31; 

) 


block_data_statement : 

RW_BLOCK_DATA  block_da ta_ident i f ier 

1 

block  data  statement (  32  ) ; 
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) 


bloc)t_data_identi  f  ier : 
IDENTIFIER 
{ 

$$  =  $1; 

) 


function_statement : 

RW_FUNCTION  function_identi f ier  optional_formal_argument_list 

{ 

function_statement (  0,  $2,  S3  ); 

> 

I 

type  RW_FUNCTION  function  identifier  optional_formal_argument_list 

( 

function_statement (  $1,  $3,  $4  ); 

) 


function_identifier : 
IDENTIFIER 
{ 

SS  *  51; 

) 


subroutine_statement : 

RW_SUBROUTINE  subrout ine_ident if ier 

( 

subroutine_statement (  $2,  0  ); 

) 

I 

RW_SUBROUTINE  subroutine  identifier  optional  formal  argument  list 
{  "  “ 
subroutine_statement (  S2,  S3  )  ; 

) 


subroutine_identif ier : 
IDENTIFIER 
( 

$$  «  SI; 

) 


entry_statement : 

RW_ENTRY  entry_identifier 
( 

entry_statement (  S2,  0  ) ; 

} 

I 

RW_ENTRY  entry_identifier  optional_formal  argument  list 

( 

entry_statement (  $2,  S3  ); 

> 


entry_identifier: 

IDENTIFIER 

1 

$$  *  $1; 

I 


opt ional_formal_argument_li st ; 
( 

SS  =  0; 

y 

i 
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'('  formal_argument_list  ')' 

( 

SS  =  $2; 

1 


formal_argument__list : 

formal_argument 

( 

$$  =  merge (  ”(%s} ",  $1  ) ; 

1 

I 

tormal_argument_ii3t  f  Oi.mai_argument 

( 

SS  =  merge (  "%s(%s}",  SI,  $3  ); 


f ormal_argument : 

IDENTIFIER 

< 

SS  -  SI; 

1 

I 

fo rmal_argument_alternate_return 

< 

SS  =  Si; 

) 


formal_argument_alternate_return: 

•  *  I 

( 

SS  ■  duplicate!  ); 

> 


end  statement: 

RW_END 

( 

end  statement (  ) ; 

1 


sped  float  ion_st  a  tement : 

external_statement 

I 

intrinsic_statement 

I 

parameter_statement 

I 

dimen sion_st at ement 

I 

declaration_statement 

I 

save_st at ement 

I 

common_s tat ement 

I 

equivalence_st a tement 
I 

impliclt_statement 

I 

data_statement 

I 

namelist  statement 


external_statement : 

RW_EXT£RNAL  external_l i st 

( 


external  statement (  $2  )  ; 
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external_list : 

external 

( 

S $  =  merge!  " { % s ) " ,  $ 1  ) ; 

> 

I 

external_list  external 

( 

$$  =  merge!  "%sf%s)“,  $1,  $3  ) ; 

> 


external : 

IDENTIFIER 

( 

$$  =  $1; 

) 


intrinsic_statement : 

RW_INTRINSIC  intrinsic_list 

{ 

intrinsic_statement (  $2  ); 

) 


intrinsic_list : 

intrinsic 

{ 

$$  =  merge!  "(%s}“ ,  SI  ); 

) 

I 

intrinsic  list  intrinsic 

( 

SS  =  merge!  n%s{%s)'\  $1,  S3  ); 

> 


intrinsic: 

IDENTIFIER 

( 

SS  -  SI; 

) 


parameter_statement : 

RW_PARAMETER  '('  parameter_list  ')' 
t 

parameter_statement !  S3  ) ; 

) 


parameter_list : 

parameter 

{ 

SS  =  merge!  "(%s)",  SI  ); 

) 

I 

parameter_list  parameter 
{ 

SS  -  merge!  "%sj%s>”,  SI,  S3  >; 

} 


parameter: 

IDENTIFIER  expression 

f 

SS  =  merge!  "(%s){%s)",  SI,  $3  ); 


dimension  statement: 
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RW_DIMENSION  dimension_list 

( 

dimension_statement (  52  )  ; 

) 


dimension_list : 

dimension 

{ 

SS  »  merge (  "(%s)"(  51  ); 

> 

I 

dimension_list  dimension 

( 

5$  =  merge(  °  %  s  (  %  s )  " ,  51,  53  ); 

) 


dimension: 

IDENTIFIER  * ( ' subscript_list  * ) * 

( 

55  =  me rge (  "{%s}{%s}",  51,  S3  ); 

> 


subscript_list : 

subscript 

1 

55  -  merge (  ”<%s}",  51  ) ; 

} 

I 

subscript_list  subscript 

( 

55  =  merge (  "»s(%s(",  51,  S3  ); 

) 


subscript : 

upper_bound 

( 

55  -  51; 

1 

I 

lower_bound  ' : '  upper_bound 
( 

55  =  merge  (  "%s:%s'\  51,  S3  ); 

> 


lower_bound: 

expression 

( 

55  -  51; 

) 


upper_bound: 

lower_bound 

( 

SS  •=  51; 

) 

I 

upper_bound_ad jus table 
( 

SS  =  51; 

1 


upper_bound_ad just able : 

•  *  t 

f 

SS  -  duplicate!  ); 

) 
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declaration_statement : 

type  declaration_list 

{ 

declaration_statement (  $1,  $2  ); 

1 


declaration_list : 

declaration 

( 

S$  =  merge  (  "(is)'1,  $1  >; 

} 

I 

declaration  list  declaration 

{ 

SS  =  merge  (  "»s(%s)“,  SI,  S3  ); 

1 


declaration: 

IDENTIFIER 

{ 

S$  =  merge  (  "(%s)'\  $1  ); 

1 

I 

IDENTIFIER  '('  subscript_list  ')' 

{ 

$S  -  merge  (  "{%s}{%s}",  $1,  $3  ); 

1 


type: 

type_name  optional_type_length 

( 

SS  =  type (  SI,  $2  ) ; 

1 


type_name: 

RW  CHARACTER 

( 

SS  =  duplicate (  "CHARACTER"  )  ; 

1 

I 

RW_COMP  LEX 

{ 

SS  «  duplicate (  "COMPLEX"  ); 

1 

RW_DOUBLE_PRECISION 

< 

SS  =  duplicate (  "DOUBLE  PRECISION"  ); 

1 

I 

RW_INTEGER 

( 

SS  =  duplicate {  "INTEGER"  ); 

) 

I 

RW_LOGICAL 

( 

SS  »  duplicate (  "LOGICAL"  ); 

) 

I 

RW_REAL 

( 

SS  -  duplicate (  "REAL"  >; 

) 

I 

RW_UNDEFINED 

( 

SS  =  duplicate (  "UNDEFINED"  ); 

I 
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optional  type_length : 
/*  NULL  */ 

1 

$$  =  0; 

} 

I 

type_length 

{ 

SS  =  $1; 

} 


type_length: 

•*'  INTEGER 

( 

SS  =  merge  (  "'is”,  S2  ); 
i 
I 

type_length_ad justable 

( 

SS  =  merge (  $2  ) ; 

1 


type_length_ad justable : 

( 

$$  =  duplicate!  "(»)•'  ); 

1 


save_statement : 

RW^SAVE  optional_save  list 

( 

save_statement (  S2  ) ; 

) 


optional  save_list: 
/•  NULL  */ 

{ 

SS  =  0; 

) 

I 

save_list 

( 

SS  -  SI; 

1 


save_list : 

save 

{ 

SS  =  merge!  "!»sl",  SI  ) ; 

i 

I 

save_list  1 , '  save 

( 

SS  =  merge!  "%s(%s)",  SI,  S3  ); 

) 


save : 

IDENTIFIER 

{ 

SS  -  SI; 

1 

I 

common_name 

< 

SS  -  SI; 

) 
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common_statement : 

RW_COMMON  optional_common  name  common_list 

( 

common_statement (  S2,  $3  ) ; 

1 


common_name : 

'/'  optional_identifier  '/' 

{ 

SS  =  S2; 

) 


optional  identifier: 
r*  NULL  */ 

( 

$$  =  0; 

) 

I 

IDENTIFIER 

( 

$S  -  $1; 

1 


common_list : 

common 

( 

$$  =  merge (  "( %s) ",  $1  ) ; 

) 

I 

common_iist  common 

l 

SS  =  merge (  SI,  S3  ); 

) 


common : 

IDENTIFIER 

( 

SS  =  merge (  SI  ); 

) 

IDENTIFIER  •(*  subscript_list  ')' 

( 

$$  -  merge  (  **{*s>  {*s>“.  SI,  $3  )  ; 

) 


equivalence_statement : 

RW_EQUI VALENCE  equi va lence_l i st 

( 

equivalence_statement (  S2  ) ; 


equivalence_list : 

equivalence 

( 


SS  =  merge (  ); 
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) 


equivalence_list  equivalence 

( 

$$  =  merge (  "%s(%s)",  SI,  S3  )  ; 

} 


equivalence : 

'('  variable_list  •)' 

{ 

$$  =  $2; 

) 


variable_li st : 

variable 

f 

$S  =  merge!  SI  ) ; 

1 

I 

variable_list  variable 

( 

SS  =  merge (  "%s{%s)“,  $1,  S3  ); 

1 


implicit_statement : 

RW_IMPLICIT  type  •('  implicit  list  •)• 

{ 

implicit_statement (  S2,  $4  ); 

1 


implicit_list : 

implicit 

{ 

$$  *  merge (  $1  ) ; 

1 

I 

implicit_list  implicit 

( 

SS  =  merge!  "%s(*s)“,  SI,  $3  ); 

) 


implicit : 

IDENTIFIER 

( 

SS  =  SI; 

1 

I 

IDENTIFIER  IDENTIFIER 

{ 

SS  »  merge!  "%s-%s",  SI,  S3  ) ; 

} 


namelist_statement : 

RW_NAMELIST  namelist_name  namel i st_l ist 

( 

namelist_statement (  S2,  S3  ); 

) 


namel ist_name: 

’/'  IDENTIFIER  V 

( 

SS  »  $2; 

) 


namelist  list: 
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name! ist 

{ 

$$  =  merge!  "{%s)“,  SI  ); 

) 

namelist_li sc  namelist 

{ 

SS  =  merge!  "%s(%s}“,  $1,  $3  ); 

} 


namelist : 

IDENTIFIER 

( 

SS  =  SI; 

) 


data_statement : 

RW_DATA  data_list 

( 

data_statement (  $2  ) ; 

1 


data_list: 

data 

{ 

SS  =  merge!  SI  ) ; 

} 

I 

data_list  optional_comma  data 

( 

SS  -  merge!  " %s(%st",  $1,  S3  ); 

) 


data: 

data_variable_list  '/'  data_constant_list  '/• 

’  SS  -  merge!  "|%s}|*s>”,  SI,  S3  ); 

) 


data_variable_list : 

data_variable 

f 

SS  =  merge!  vl  ); 

! 

I 

data_variable_list  data_variable 

i 

SS  =  merge!  ” % s ( % s ) " ,  $1,  S3  ); 

) 


data_variable : 

variable 

( 

SS  =  SI; 


data_implied_do_list 

( 

SS  =  SI; 


data_impl ied_do_li st : 

'('  dat a_va r i able_I i st  IDENTIFIER  expression_1 ist  ')' 

( 

SS  '  impl  ied_c.o_l  i  st  (  $2,  SI,  S6  ); 

) 
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da  t a_ccnst ant _I i st : 

data_constant 

{ 

$$  -  merge (  ”  !%s(",  $1  ); 

1 

) 

data_constant_l i st  aat a_constant 

( 

$$  =  merge!  "%s{%s)"r  51,  $3  ); 

I 


data_constanc : 

data  initialization 

( 

35  =  51; 

} 

I 

IDENTIFIER  data_init ial i zat ion 

( 

5$  =  merge!  "<ks  *  %s”,  51,  S3  ); 

) 

I 

INTEGER  data_initializatio-' 

( 

55  =  merge!  "%s  *  %s",  51,  53  )  ; 

( 


nit ialization: 

IDENTIFIER 

( 

55  =  51; 

) 

character  constant 

( 

S>  =  51; 

) 

logical_constant 

i 

55  -  51; 

I 

signed_numerical_constant 

f 

55  -  51; 

} 


signed_numeri ca  1  constant: 

numerical  constant 

( 

55  =  51; 

) 

I 

1 +  *  numerical_constant  %prec  SIGN 

( 

55  =  merge!  "  +  %  s  " ,  52  ); 

) 

I 

*-•  numerical_constant  %prec  SIGN 

( 

5S  *  merge!  "-%s",  52  ); 
l 


expre'sion : 

pa  renthesi s_expression 

( 

SS  =  51; 

) 


data  i 


I 


I 


simple_expression 
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f 

$$ 

> 


SI; 


pa rent he s i s_expression : 

' ( '  expression  ' ) ' 

{ 

$S  =  merge  (  "  (%s)  '*,  $2  )  ; 

( 


simple_expression: 

variable 

SS  =  SI; 

) 

t 

constant 

( 

SS  =  SI; 

> 

I 

ari thmetic_expression 

( 

SS  =  SI; 

) 

I 

character_expression 

{ 

SS  =  SI; 

) 

I 

relational_expression 

< 

SS  =  SI; 

) 

I 

logical_expression 

( 

SS  =  SI; 

1 

I 

unary_expression 

( 

SS  =  SI; 

) 


variable : 

IDENTIFIER 

( 

SS  =  SI; 

) 


IDENTIFIER  st ri ng_subset 

( 

SS  =  merge!  "%s  %s", 

) 

array 

( 

SS  =  SI; 

) 


SI, 


S2  )  ; 


array : 


I 


IDENTIFIER  '('  optional_expression_list 

f 


SS  =  array (  SI,  S3  )  ; 

> 

IDENTIFIER  '('  opt ional  express i on_ 1 i 

( 

SS  =  merge!  "%s  lis”,  array!  SI,  S3  ) 

i 


’  )  1 


’ )  '  string 


,  SS  )  ; 


subset 
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optional  expression_list : 
F*  NULL  */ 

1 

$$  =  0; 

) 

I 

expression_list 

t 

SS  =  $1; 

1 


express ion_li st : 

expression 

t 

$$  =  merge (  Si  ); 

) 

1 

expression_llst  ' , '  expression 

{ 

$$  *  merge (  "%s{%s}",  SI,  S3  ); 

1 


string_subset : 

•('  optional  expression  1 : 1  optional_expression  ')' 

( 

S$  «  merge  (  "(%s:%s)“,  $2,  S4  ); 

1 


optional  expression: 
/*  NULL  */ 

< 

SS  =  0; 

1 

I 

expression 

{ 

SS  =  SI; 

1 


constant : 

character_constant 

( 

SS  =  SI; 

) 

I 

logical_constant 

1 

SS  =  SI; 

1 

I 

numerical_constant 

{ 

SS  =  SI; 

1 


character_constant : 
HOLLERITH 
( 

SS  »  SI; 

) 

I 

STRING 

( 

SS  -  SI; 
I 


logical_constant: 
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RW_FALS£ 

{ 

$$  =  duplicate (  ".FALSE."  ); 

} 

RW_TRUE 

( 

$$  =  duplicate (  ".TRUE."  ); 

} 


numerical_constant : 

DOUBLE_PR£CISION 

( 

$$  =  $1; 

) 

I 

INTEGER 

( 

SS  =  $1; 

} 

I 

REAL 

{ 

5$  =  SI; 

) 


ari thmetic_expression: 

expression  •+'  expression  %prec  1 +  ' 

{ 

SS  =  merge!  "%s  +  %s",  $1,  $3  ); 

> 

I 

expression  • expression  %prec  ‘-1 

( 

SS  =  merge!  "%s  -  %s",  SI,  S3  ); 

1 

I 

expression  expression  %prec 

{ 

SS  =  merge!  "%s*%s",  SI,  $3  ) ; 

) 

I 

expression  '/'  expression  %prec  '/' 

( 

S S  =■  merge!  " % s / % s " ,  SI,  S3  )  ; 

) 

I 

expression  EXPONENTIATE  expression  %prec  EXPONENTIATE 

< 

SS  =  merge!  "%s**%s",  SI,  S3  ); 

} 


character_expre3sion: 

expression  '/'  '/'  expression  %prec  CONCATENATE 

( 

SS  =  merge!  "»s  //  %s",  SI,  S4  ); 

) 


relat ional_expression: 

expression  RW_EQ  expression  %prec  RW_EQ 

( 

SS  =  merge!  "»s  .EQ.  %s",  SI,  S3  ); 

) 

I 

expression  RW_NE  expression  %prec  RW_NE 
( 

SS  -  merge!  "%s  .NE.  %s",  SI,  S3  ); 

) 

I 

expression  RW_LT  expression  %prec  RW_LT 
( 

SS  =  merge!  "%s  .LT.  %s",  SI,  S3  ) ; 

I 
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expression  RW_LE  expression  %prec  RW_LE 

( 

SS  =  merge (  "%s  .LE.  ts",  SI,  S3  ); 

} 

expression  RW_GT  expression  %p _  RW  GT 

{ 

SS  =  merge (  "%s  .GT.  %s",  $1,  S3  ); 

) 

expression  RW_GE  expression  %prec  RW_GE 

{ 

SS  =  merge (  ”»s  .GE.  %s",  SI,  S3  ); 

1 


logical_expression: 

expression  RW_AND  expression  %prec  RW_AND 

< 

SS  =  merge (  "%s  .AND.  %s“,  SI,  S3  >; 

} 

I 

expression  RW_OR  expression  %prec  RW_OR 

{ 

SS  -  merge (  "%s  .OR.  %s",  SI,  S3  ); 

1 

I 

expression  RW_EQV  expression  %prec  RW_EQV 

{ 

SS  *  merge (  "%s  .  EQV.  %s",  SI,  S3  ) ; 

] 

I 

expression  RW_NEQV  expression  %prec  RW_NEQV 

1 

SS  *  merge (  "is  . NEQV .  %sM,  51,  $3  ); 

) 


unaryexpression: 

'+'  expression  %prec  SIGN 

( 

SS  »  merge (  "+%s",  S2  ) ; 

} 

I 

expression  %prec  SIGN 

{ 

S  S  =  me  rge  (  "  -  %  s  " ,  S  2  )  ; 

) 

I 

RW_NOT  expression  %prec  RW_NOT 

( 

SS  =  merge (  ".NOT.  ts",  $2  ); 

} 


executable_statement : 
do_statement 

I 

logical_i£_statement 

I 

bloclc_if_statement 

I 

else_statement 

I 

else_i f_statement 

I 

end_i f_statement 
I 

subset  executable  statement 


do_statement : 

RW_DO  INTEGER  IDENTIFIER  exoression_i i st 

{ 

computation (  0  ) ; 
do  statement)  S2,  S3,  SS  ); 
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) 


logical  i f_statement : 

1f_expression  subset  executable 

( 

logical_i f_statement (  ); 

} 


if_expression: 

RW_IF  '('  expression  ')' 
{ 

computation (  0  ); 
if_expression (  S3  ); 

} 


block_if_statement : 

RW_IF  •('  expression  ' ) *  RW  THEN 
{ 

computation  (  0  ); 
block_if_statement (  S3  ); 

} 


else_statement : 

RW_ELSE 

( 

computation (  0  ); 
else_statement (  ); 

) 


else_i f_statement : 

RW_ELSE_IF  '('  expression  ' ) 1  RW 
{ 

computation;  0  ); 
eioe_if_statement (  $3  ); 

) 


end_i f_statement : 

RW_END_IF 

( 

computation;  0  ); 
end_i f_statement (  ); 

) 


subset_executable_statement : 

assignment _statement 
I 

assign_statement 

I 

arithmetic_i f_statement 
I 

conti nue_statement 

I 

call  statement 


return_statement 

uncondit ional_go_to_statement 

computed_go_to_statement 

assigned_go_to_statement 

stop_statement 

pause_statement 


statement 


THEN 


io  statement 
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assignment_statement : 

variable  '='  expression 

( 

computation (  0  ); 
assignment_statement (  $1,  S3  ); 

\ 


assign_stateraent : 

RWJtSSIGN  INTEGER  RW_TO  IDENTIFIER 
{ 

computation (  0  ); 
assign_statement (  $2,  $4  ); 


arithmetic_if_statement : 

RW_IF  *)'  expression  integer_list 

( 

computation)  0  ); 

arithmetic_if_statement (  $3,  S5  ); 

) 


continue_statement : 

RW_CONT I NUE 
t 

computation)  0  ); 
continuestatement (  ) ; 

1 


call_statement: 

RW_CALL  IDENTIFIER 

{ 

computation)  $2  ); 
call_statement (  $2,  0  ) ; 

1 

RW_CALL  IDENTIFIER  optional  actual  argument  list 

( 

if  (  (  strncmp)  $2,  "send_“,  strlen)  “send_”  )  ) 
II  (  strncmp)  $2,  "receive_",  strlen)  "receive 
communication)  $2,  list)  duplicate)  S3  ) , 

else 

computation)  $2  ); 
call_statement (  $2,  S3  ) ; 

1 


0  ) 

0  )  ) 


optional_actual_argument  list: 

'  ( '  ' )  ’ 

1 

$$  -  0; 

) 

I 

'('  actual_argument_list  ')' 

( 

$S  «  S2; 

) 


actual_argument_list : 

actual_argument 

( 

SS  -  merge)  "  (%s)",  $1  )  ; 

) 

I 

actual  argument_list  actual_argument 

( 

SS  =  merge)  "%s)*s}"(  SI,  S3  ); 
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) 


actual_argument : 

expression 

( 

$$  =  $1; 

) 

I 

actual_argument_alternate  return 

{ 

$S  =  $1; 

) 


actual_argument_alternate_return: 

•  * '  INTEGER 

( 

$$  =  merge (  "*%s",  $2  ); 

> 


return_statement : 

RW_RETURN  optional  expression 

( 

computation  (  0  ); 
return_statement (  $2  ) ; 

1 


unconditional_go_to_statement : 

Rw_GO_T°  INTEGER 

{ 

computation!  0  ); 

unconditional  go  to  statement!  $2  ); 
1  ~  " 


computed_go_to_statement : 

RW  GO  TO  *('  integer  list  ')'  optional  comma  expression 

{ 

computation!  0  ); 

computed_go_to  statement!  S3,  $6  ); 

) 


assigned_go_to_statement : 

Rw_G°_TO  IDENTIFIER 

{ 

computation!  0  ); 

assigned  go_to  statement!  $2,  0  ); 

1 

I 

RW_GO_TO  IDENTIFIER  optional  comma  '('  integer  list 

( 

computation!  0  ); 

assigned_go_to_statement (  $2,  $5  ); 

) 


optional  comma: 

r*  NULL  */ 
I 


integer_list : 

INTEGER 

( 

SS  =  merge (  ” ( %s) ",  SI  ) ; 

) 

I 

integer_list  INTEGER 
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< 

S$  =  merge!  "is^s)",  SI,  S3  ); 

1 


pause_statement : 

RW_PAUSE  optional_expression 
! 

computation!  0  ); 
pause_statement (  $2  ) ; 

) 


stop_statement : 

RW_STOP  optional_expression 

( 

computation!  0  ); 
stop_statement (  $2  ) ; 

) 


io_statement : 

open_statement 

I 

close_statement 

I 

inquire_statement 

I 

readstatement 

I 

write_statement 

I 

printstatement 

I 

backspace_statement 

I 

rewind_statement 

I 

endfile  statement 


open_statement : 

RW_OPEN  •('  control_information_list  ')' 
( 

computation!  0  ); 
open_statement (  S3  ) ; 

) 


close_statement : 

RW_CLOSE  *('  control_information_list  ')' 
( 

computation!  0  ); 
close  statement!  S3  ); 

) 


inquire_statement : 

RW_INQUIRE  '('  control_inf ormation  list  ')’ 

( 

computation!  0  ); 
inquire_statement (  S3  ) ; 

) 


read_statement : 

RW  READ  '('  control_information_l ist  ')'  optional_io  list 

( 

computation!  0  ); 
read_statement (  S3,  55  ); 

I 


RW  READ  control 
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computation (  0  ); 
read_statement (  $2,  0  ); 

1 

RW_R£AD  control  io_list 

{ 

computation)  0  ); 
read_statement (  $2,  $4  )  ; 

1 


write_statement : 

RW_WRITE  '('  control_in£ormation_list  ')'  optional_io_list 

{  . 

computation (  0  ); 
write_statement <  S3,  S5  ); 

) 


print_statement : 

RW_PRINT  control 

< 

computation)  0  ); 
print_statement (  $2,  0  ); 

1 

I 

RW_print  control  io_list 

< 

computation)  0  ); 
print_statement (  $2,  $4  ); 

1 


backspace_statement : 

RWBACKSPACE  '('  control_information_list  •)■ 

f 

computation)  0  ); 
backspace  statement (  $3  ) ; 

I 

I 

RWBACKSPACE  control 

( 

computation)  0  ) ; 
backspace  statement (  $2  ) ; 

) 


rewind_statement : 

RW_REWIND  '('  control_information_list 

( 

computation)  0  ); 
rewind_statement (  $3  ) ; 

1 

I 

RW_REWIND  control 
{ 

computation)  0  ); 
rewind_statement (  S2  ) ; 

) 


endf i le_statement : 

RW_ENDF I LE  ’('  control  inf ormat ion_l i st  ')’ 
{ 

computation)  0  ) ; 
endfile  statement)  S3  ); 

) 

I 

RW_ENDFILE  control 

( 

computation)  0  ); 
endfile_statement (  $2  ); 

) 
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control_information_list : 

control_information 

{ 

$$  =  merge (  " ( %s}",  $1  ) ; 

1 

I 

control_information_list  1  control 

( 

SS  =  merge (  ”%s(%s)“,  SI,  $3  ); 

) 


cant rol_in format ion : 
control 
( 

SS  =  SI; 

) 

I 

IDENTIFIER  '='  expression 

1 

S$  =  merge (  ”%s  =  %s“,  SI,  $3  ); 

1 


control : 

variable 

( 

SS  -  SI; 

1 

I 

constant 

( 

SS  =  SI; 

1 


( 

SS  -  duplicate!  ); 

1 


optional  io_list: 

r *  NULL  */ 

( 

SS  =  0; 

) 

I 

io_list 

( 

SS  -  Si; 

) 


io_list : 

io 

{ 

SS  =  merge!  "!%s>",  SI  ) ; 

1 

I 

io_list  ' , •  io 

{ 

SS  =  merge!  "%s(%s(",  SI,  S3  ); 

) 


io : 

expression 

( 

SS  -  SI; 

I 

I 

io_impl ied_do_l i st 

( 

SS  =  SI; 

) 


information 
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io_impl ied_do_l i sc : 

'('  io_list  IDENTIFIER  expression_list 

( 

$$  =  implied_do_list (  $2,  $4,  $6  ); 

) 


format_statement : 

RW_FORMAT 

( 

format_statement (  $1  ) ; 

) 


%% 


FILE:  etimer/include/list .h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦define  LIST  struct  list_type 
LIST 
( 

char  ‘identifier; 
char  ‘type; 
int  number; 
int  length; 
char  ‘dependent; 

LIST  ‘next; 

> ; 


extern  LIST  *end_list (  )  ; 
extern  LIST  ‘add  list (  )  ; 
extern  LIST  *finH_list<  ); 
extern  void  print_list(  ); 
extern  void  delete_list (  )  ; 


FILE:  etimer/library/Makef ile 


* 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


CC  *  cc  -g 
INCLUDE  -  ../include 
CFLAGS  -  -IS (INCLUDE) 
LIBRARY  -  library. a 


OBJECTS  =  \ 
alias. o  \ 
array. o  \ 
collapse. o  \ 
count. o  \ 
duplicate. o  \ 
hollerith.o  \ 
implied_do_list .o  \ 
label. o  \ 
link_list.o  \ 
list . o  \ 
lowercase. o  \ 
main.o  \ 
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margi.n_pri.nt f . o  \ 
me  rge .  o  \ 
non_blank.o  \ 
parse. o  \ 
print_level . o  \ 
stack. o  \ 
statement. o  \ 
summary. o  \ 
timer. o  \ 
type.o  \ 
type_name . o  \ 
update. o  \ 
yyerror.o  \ 
yygetc.o  \ 
yywrap. o 


S (LIBRARY) : S (OBJECTS) 
rm  -f  $ (LIBRARY) 
ar  crv  S (LIBRARY)  S (OBJECTS) 
ranlib  $ (LIBRARY) 


.SUFFIXES:  .c  .o 
■  c.o: 

S(CC)  -c  S(CFLAGS)  $< 


clean: 

rm  -f  $ (LIBRARY)  $ (OBJECTS) 
FILE:  et imer/library/alias . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


#include  <stdio.h> 
♦include  <string.h> 


extern  int  yylineno; 
extern  char  'duplicate!  ); 
extern  char  'lowercase (  ); 


♦define  ALIAS  struct  alias_type 
ALIAS 
( 

char  *old_identif ier; 
char  *new_identi f ier; 

1; 


static  ALIAS  alias_table[  ]  » 

1 

(  ■■  ■«  } 

>; 


♦define  ALIAS  TABLE  (  sizeof(  alias  table  )  /  sizeofl  ALIAS  )  ) 


char  *alias(  identifier  ) 
register  char  'identifier; 

( 

register  int  low,  high; 
register  int  middle,  test; 

lowercase)  identifier  ); 

low  =  0; 

high  *  ALIAS_TABLE  -  1; 


while  (  low  <=  high  ) 
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< 

middle  =  (  low  +  high  )  /  2: 

test  =  stremp)  identifier,  alias_tabie[  middle  J . old_ident i f ier  ); 

if  (  test  <  0  ) 

{ 

high  =  middle  -  1; 
continue; 

} 

if  (  test  >  0  ) 

< 

low  =  middle  +  1; 
continue; 

) 

fprintfl  stderr,  "line  %d,  %s  aliased  to  %s\n",  yylineno,  identifier,  al!a:._tabie  ' 
middle  ] . new_identi f ier  ); 

return)  alias_table[  middle  ] . new_iaenti f ier  ); 

1 

return)  identifier  ); 

}  /*  alias  */ 


FILE;  etimer/library/array . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  char  *list<  ); 
extern  char  "merge  (  ) ; 


char  "array)  identifier,  optional_expression_list  ! 

register  char  "identifier; 

register  char  "opt ional_expression_l i st ; 

( 

if  (  optional_expression_list  !=  (char  *)0  ) 

return)  merge)  "ts(%s)",  identifier,  list)  optional_expression_list,  ”,  "  )  )  ) ; 

else 

return)  merge)  "%sO”,  identifier  )  ); 
t  /*  array  */ 


FILE:  et imer/1 ibrary/collapse . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <string.h> 


extern  char  "merge)  ); 
extern  char  "parse)  ); 


char  "collapse)  input  list  ) 
register  char  *input_Tist; 

{ 

reaister  char  "input  =  (char  *)NULL; 
int  number  =  -1; 

register  char  *old_input  =  (char  *)NULL; 
int  old_number  -  -1; 

register  char  *output_list  «  (char  *)NULL; 
register  char  "output; 
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while  (  (  input  =  parse!  input_list  )  )  !=  (char  “(NULL  ) 

t 

sscanf  (  input,  "%d",  snumber  ); 

if  (  (  old  number  +  1  J  !=  number  ) 

( 

if  (  old_input  !=  (char  “IN'JLL  ) 

( 

if  (  output_list  !=  (char  “)NULL  ) 

f 

output  =  merge!  “%s { %s ) { %s l output_list,  old_input, 
free!  output_list  ); 

) 

el  se 

output  =  merge  (  ■■  (%s(  old_input,  input  ); 

free(  old_input  ); 

1 

else 

( 

if  (  output_list  ! -  (char  “(NULL  ) 

{ 

output  =  merge (  "ls(ts)H,  output_list,  input  ); 
free(  output_list  ); 

I 

else 

output  =  merge)  "{%s|“,  input  ); 

) 


free(  input  ); 
output_list  =  output; 


old_input 

1 


(char  * ) NULL; 


else 

old_input  =  input; 
old_number  =  number; 


if  (  -i!d_input  !-  (char  “INULL  ) 

( 

if  (  output  list  !»  (char  “INULL  ) 

( 

output  *  merge)  "%s(%st‘‘,  output_iist,  old_input  ); 
free(  output_list  ); 

) 

else 

output  =  merge!  "<%s)",  old_input  ) ; 

free!  old_input  ); 

output_list  =  output; 

I 


return!  output_list  ); 
)  /*  collapse  •/ 


FILE;  etimer/library/count .  c 


/  * 

*  Copyright  1991 

»  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


int  count  !  string,  length,  c  ) 
register  char  “string; 
register  int  length; 
register  char  c; 
f 

register  int  c_count  = 

while  (  length  ! •  0  ) 

( 

if  (  “string  ==  c  ) 
c  count ++; 


input 


0; 
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string”; 

length--; 


return)  c_count  ); 
1  /*  count  ’/ 


FILS:  etimer/1 ibrary/duplicate . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  I aboratory 

*  Author:  Stephen  R.  Wachtei 

’/ 


#include  <stdio.h> 
#include  <string.h> 
♦include  <malloc.h> 


char  ’duplicate!  string  ) 
register  char  ’string; 

{ 

register  char  ’temporary  =  (char  ’(NULL; 

if  (  string  !=  (char  ’(NULL  ) 
i 

if  (  (  temporary  =  (char  *)mailoc(  strlenl  string  )+!))!=  (char 

strcpy(  temporary,  string  ); 

else 

fprintf (  stderr,  "ERROR:  duplicate (  4s  ) \n",  string  ); 

) 

return!  temporary  )  ; 

)  /*  duplicate  */ 


FILE:  etimer/library /holleri th .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 
*/ 


♦include  <stdio.h> 


char  *hollerith(  string,  delimeter  ) 
register  char  ’string; 
register  char  delimeter; 

( 

int  hollerith_length; 
register  int  st ring_length  =  0; 

sscanfl  string,  "%dh",  shol le r i t h_iength  ); 

string!  st  ring_length”  j  =  delimeter; 
while  (  hoi le r i t h_lengt h  !=  0  ) 

f 

if  (  (  string!  string_length  j  =  yyinput (  )  )  ==  '\n'  ) 

{ 

yyunput (  string!  st ri ng_lengt h  )  ); 

break; 

) 

st ring_length”; 
hoi lerith_ length-- ; 

I 

string!  strir.g_length”  i  =  delimeter; 

string!  st r i ng_lengt h  ;  =  'NO'; 

return (  string  ) ; 


’(NULL  ) 
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>  /*  hollerith  */ 


FILE:  etimer/library/impl ied_do_list . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  char  ‘list  (  ); 
extern  char  "merge (  ); 


char  *implied_do_list (  variable_list,  identifier,  expression_list  ) 
register  char  *variable_list; 
register  char  "identifier; 
register  char  *expression_list; 

{ 

return (  merge (  "(%s,  %s  -  %s)",  list(  variable_list,  ",  "  ),  identifier, 
expression_list,  “,"))); 

1  /*  implied_do_list  */ 


FILE:  etimer/library/label . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 


char  "label (  string  ) 
register  char  "string; 

{ 

if  (  string  !=  (char  *)0  ) 

margin_printf (  "%d\t",  atoi (  string  )  ); 
else 

margin_printf (  "\t"  ); 

while  (  check_stac)c  (  string  )  !=  0  ) 

( 

pull_stacM  )  ; 
level — ; 

} 

return (  string  ); 

}  /*  label  */ 


FILE:  etimer/library/linh_list.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


linclude  <stdio.h> 
♦include  <malloc.h> 
♦include  "list.h" 


LIST  *end_list(  list  ) 
register  LIST  "list; 

( 

if  (  list  ! *  (LIST  * ) NULL  ) 
{ 


list  ( 
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while  (  list->next  !=  (LIST  *)NULL  ) 
list  =  list->next; 

} 

return!  list  ); 

)  /*  end  list  */ 


LIST  ‘add_list<  list,  identifier,  type,  number,  length  ) 

register  LIST  “list; 

register  char  ‘identifier; 

register  char  ‘type; 

register  int  number; 

register  int  length; 

{ 

register  LIST  ‘temporary  =  (LIST  ‘)malloc(  sizecf (  LIST  )  ); 

temporary->identifier  =  identifier; 
temporary->type  =  type; 
temporary->number  =  number; 
temporary->length  =  length; 
temporary->dependent  =  (char  *)NULL; 
temporary->next  =  (LIST  *)NULL; 

if  (  ‘list  ==  (LIST  *  J  NULL  ) 

•list  =  temporary; 

else 

end_list(  ‘list  ) ->next  =  temporary; 

return  (  temporary  ); 

)  /*  add  list  */ 


LIST  »find_list(  list,  identifier,  type  ) 
register  LIST  ‘list; 
register  char  ‘identifier; 
register  char  ‘type; 

( 

while  (  list  ! »  (LIST  *)NULL  ) 

( 

if  (  (  strcmpf  identifier,  list->identif ier  )  0  ) 

it  (  strncmpf  type,  list->type,  strlenf  type  )  )  ==  0  )  ) 
return!  list  ) ; 

list  =  list->next; 

) 

fprintf(  stderr,  "ERROR:  find_list(  %s,  %s  )\n”,  identifier,  type  ); 
exit (  -1  ) ; 

}  /*  find  list  */ 


void  print_list(  file,  list  ) 
register  FILE  ‘file; 
register  LIST  ‘list; 

( 


while  (  list  !=  (LIST  *)NULL 

) 

if  {  list->identi f ier 

(char  * ) NULL  ) 

fprintfi  file, 

"  ) ; 

else 

fprintf (  file,  "%s  ”, 

list->identif ier  ); 

if  (  list->type  ==  (char 

* ) NULL  ) 

fprintf!  file, 

"  ) ; 

else 

fprintfi  file,  "%s  ", 

1  ist->type  )  ; 

fprintfi  file,  "%d  %d\n". 

list->number,  list->length 

list  =  list->next; 

) 


fprintft  file,  ”\n"  ); 
(  /*  print_list  */ 


void  deiete_list(  list  ) 
register  LIST  ‘list; 

{ 


if  (  list  !=  NULL  ) 
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{ 

delete_list (  list->next  ); 
free!  list  ); 

1 

)  /*  delete_list  */ 


FILE:  etimer/library/list .c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Labo .atory 

*  Author:  Stephen  R.  Wachtel 

'/ 


extern  char  'parse (  ); 
extern  char  'merge (  ); 


char  *list(  input_list,  delimeter  ) 
register  char  'input_list; 
register  char  'delimeter; 

( 

register  char  'output_list; 
register  char  'list; 
register  char  'temporary; 

output_list  =  parse!  input_list  ); 
list  »  parse (  input_list  ); 

while  (  list  !=  (char  ')0  ) 

{ 

temporary  =  merge!  "%s%s%s",  output_l,.st,  delimeter, 

free!  output_list  ); 

free!  list  ); 

output_list  »  temporary; 

list  »  parse!  input_list  ); 

) 

return!  output_list  ); 

)  /*  list  */ 


FILE:  et imer/library/lowercase . c 


/* 

'  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
'/ 


char  'lowercase!  string  ) 
register  char  'string; 

( 

register  int  index  «  0; 

while  (  string!  index  1  !=  '\0'  ) 

{ 

string!  index  ]  =  tolower!  string!  index  ]  ); 
index++; 

) 

return!  string  ); 

)  /*  lowercase  */ 


FILE:  et imer/1 ibrary /main . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 


list  ); 
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*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 


extern  FILE  ‘yyin; 
extern  FILE  ‘yyout; 


♦define  PROGRAM  argument [  0  ] 
♦define  INPUT_FILE  argument!  1  ] 
♦define  OUTPUT_FILE  argument!  2  ) 


int  main!  number_argument,  argument  ) 
int  number_argument; 
char  ‘argument [  ] ; 

{ 

if  (  number_argument  ==  1  ) 

( 

yyin  »  stdin; 
yyout  =  stdout; 

yyparse (  ) ; 
exit <  0  ) ; 

} 


if  (  number_argument  ==  3  ) 

{ 

if  (  (  yyin  =  fopen<  INPUT_FILE,  ”r“  )  )  »«  (FILE  *)NULL  ) 

( 

fprintf!  stderr,  "%s:  ERROR  -  unable  to  open  input  file 
INPUT_FILE  ) ; 

exit!  -1  ) ; 


) 

if  (  (  yyout  -  f open  (  OUTPUT  FILE,  “W  )  )  ==  (FILE  *)NULL  ) 

{ 

fprintf!  stderr,  “%s:  ERROR  -  unable  to  open  output  file 
OUTPUT_FILE  ) ; 

exit!  -1  ) ; 


> 


%s 1 \n" ,  PROGRAM, 


•%s'\n”,  PROGRAM, 


yyparse!  ) ; 
exit!  0  ) ; 


fprintf!  stderr,  "usage:  %s  <input  file>  <output  fiie>\n”,  PROGRAM  ) ; 
exit  (  0  ) ; 

1  /*  main  */ 


FILE:  etimer /library/margin_printf.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <string.h> 


extern  FILE  ‘yyin; 
extern  FILE  ‘yyout; 


static  char  buffer!  256  •  20  ]  =  (  0  }; 


static  void  output_buf fer (  file  ) 
register  FILE  ‘file; 

( 

♦define  LENGTH  72 
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int  length  =  LENGTH; 
int  continuation  =  0; 
int  quote  **  0; 
char  temporary; 

while  (  strlen!  buffer  )  >  length  ) 

{ 

if  (  continuation++  !=  0  ) 

fprintf (  file,  "  s"  ); 

quote  +=  count (  buffer,  length,  1 \ 1 1  ); 
if  (  (  quote  %  2  )  ==  0  ) 

( 

while  (  length  !=  0  ) 

{ 

if  (  buffer [  length  -  0  1  ==  1 \  '  ) 
break; 

if  (  buffer[  length  -01==  '\,'  ) 
break; 

if  (  buffer!  length  -  1  1  ==  '  \ 1  1  ) 
break; 

length — ; 

1 

if  (  length  ==  0  ) 

< 

fprintf (  stderr,  “ERROR:  margin  printf()\n"  ); 
exit (  -1  ); 

1 

1 

temporary  =  buffer!  length  1; 
buffer!  length  1  =  'VO1; 
fprintf!  file,  "%s\n“,  buffer  ); 
buffer!  length  ]  =  temporary; 

strepy!  Sbuffer!  0  1,  Sbuffer!  length  1  ); 
length  =  LENGTH  -  6; 

) 

if  (  strlen!  buffer  )  !=  0  ) 

{ 

if  (  continuation++  !=  0  ) 

fprintf!  file,  "  s'*  ); 

fpr^r.f'',  file,  "%s\n“,  buffer  ); 

1 

1  /*  output_buf fer  */ 


void  margin_printf (  format,  a,  b,  c,  d,  e  ) 

char  “format; 

int  a,  b,  c,  d,  e; 

1 

char  temporary!  256  *  20  ]; 

sprintf!  temporary,  format,  a,  b,  c,  d,  e  ); 
streat!  buffer,  temporary  ); 

if  (  buffer!  strlen!  buffer  )  -  1  1  ==  '\n'  ) 

{ 

buffer!  strlen!  buffer  )  -  1  1  =  '\0'; 

while  (  buffer!  strlen!  buffer  1-11=='') 
buffer!  strlen!  buffer  )  -  1  1  =  '\0'; 

switch  (  buffer!  0  ]  ) 

( 

case  ' \0 ■ : 

fprintf!  yyout,  "\n"  ); 
break; 

case  ' * ' : 
case  ' c ' : 
case  *C' : 

fprintf!  yyout,  "%s\n",  buffer  ); 
break; 
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default : 

output_tuf fer (  yyout  ); 

} 

buffer!  0  1  =  '\0'; 

1 

)  /*  margin_printf  */ 


FILE:  etimer/library/merge.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  <malloc.h> 


♦  define  STRLEN  <  s  )  (  strlenl  s  )  -  2  ) 


char  ‘merge (  string,  a,  b,  c,  d  ) 
register  char  ‘string; 
register  char  ‘a; 
register  char  *b; 
register  char  *c; 
register  char  *d; 

{ 

register  char  ‘temporary  =  (char  *)NULL; 

switch  (  count <  string,  strlen<  string  ),  '%•  )  ) 

( 

case  0: 

if  (  (  temporary  =  (char  *)malloc(  strlenl  string  )  +  1  )  )  !=  (char  ‘(NULL  ) 
sprintf(  temporary,  string  ); 

else 

fprir.tf(  stderr,  “ERROR:  merge!  %s  )\n",  string  ); 

break; 

case  1 : 

if  (  (  temporary  »  (char  *)malloc(  strlenl  string  )  +  STRLEN (  a  )  +  1  )  )  != 

(char  ‘(NULL  ) 

sprintfl  temporary,  string,  a  ); 

else 

fprintf (  stderr,  "ERROR:  merge (  %s,  %s  )\n”,  string,  a  ); 

break; 

case  2: 

if  (  (  temporary  =  (char  ‘(mallocl  strlenl  string  )  +  STRLEN!  a  )  +  STRLEN (  b 
)  +  1  )  )  !*  (char  ‘(NULL  ) 

sprintf(  temporary,  string,  a,  b  ); 

else 

fprintf (  stderr,  "ERROR:  merge (  %s,  %s,  %s  )\n",  string,  a,  b  ); 

break; 

case  3: 

if  (  (  temporary  =  (char  *! mallocl  strlenl  string  )  +  STRLEN!  a  )  +  STRLEN (  b 
)  +  STRLEN (  c  )  +  1  )  )  !=  (char  ‘(NULL  ) 

sprintf(  temporary,  string,  a,  b,  c  ); 

else 

fprintf!  stderr,  "ERROR:  merge)  »s,  %s,  %s,  %s  )\n",  string,  a,  b,  c  ); 

break; 

case  4: 

if  (  (  temporary  =  (char  *) mallocl  strlenl  string  )  +  STRLEN  (  a  )  +  STRLEN (  b 
)  +  STRLEN!  c  )  +  STRLEN (  d  )  +  1  )  )  !=  (char  ‘(NULL  ) 

sprintff  temporary,  string,  a,  b,  c,  d  ); 

else 

fprintf!  stderr,  "ERROR:  merge!  %s,  %s,  %s,  %s,  %s  )\n",  string,  a,  b,  c,  d 

)  ; 

break; 

default : 

fprintf!  stderr,  "ERROR:  merge (  %s  )\n",  string  ); 
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break; 

} 

return (  temporary  )  ; 

)  /*  merge  */ 


FILE:  etimer/Iibrary/non_blank. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

»  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <string.h> 


char  *non_blank(  string  ) 
register  char  ‘string; 

{ 

register  int  offset; 
register  int  length; 


length  »  strlen!  string  )  -  1; 
while  <  (  string!  length  ]  »» 
string!  length —  1  =  '\0'; 

offset  ■  0; 

while  (  (  string!  offset  )  == 
string!  offset++  1  =  '\0'; 


)  it  (  string!  length 


)  ss  (  string!  offset 


!=  '\0'  )  ) 

!=  '\0'  )  ) 


strcpyf  string,  Sstring!  offset  ]  ); 


if  (  strlen(  string  )  !=  0  ) 

return!  string  ); 

else 

return (  0  ) ; 

}  /*  non_blank  */ 


FILE:  etimer/library/par3e.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <string.h> 


extern  char  ‘duplicate!  ); 


char  ‘parse!  list  ) 
register  char  ‘list; 

{ 

register  int  length  »  0; 

register  int  brace  -  0; 

register  char  ‘temporary  =  (char  *)0; 

for  (;;) 

( 

switch  (  list!  length  )  ) 

( 

case  •  (  •  : 

brace++; 

break; 

case  '  }  ‘  : 

brace--; 

break; 

1 
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if  (  brace  ==  0  ) 
break; 

length++; 

) 


if  (  length  !=  0  ) 

{ 

list[  length  ]  =  '\0'; 
temporary  -  duplicate!  list  +  1  ); 
strcpyi  list,  list  +  1  +  length  ); 

) 

else 

{ 

if  (  list[  length  )  !=  • \0 ’  ) 

( 

temporary  =  duplicate!  list  ); 
list[  length  ]  =  '\0*; 

) 

) 

return (  temporary  ) ; 

}  /’  parse  */ 


FILE :  etimer/ library /print_level . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


int  level  =  0; 


void  print_level (  level  ) 
register  int  level; 

{ 

if  (  level  !=  0  ) 

( 

while  (  level —  ! =  0  ) 

margin_printf (  "  "  ); 

t 

)  /*  print_level  */ 


FILE:  etimer/library/stack.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 


* define  STACK  128 
static  struct 

f 

char  ‘label; 

)  Stack!  STACK  ]; 
static  int  pointer  =  0; 


int  push_stack (  label  ) 
register  char  ‘label; 

f 

if  (  pointer  !=  STACK  ) 

{ 

stack!  pointer  ]. label  =  label; 

pointer++; 
return (  1  ) ; 
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) 

return (  0  ) ; 

}  /*  push_stack  */ 


int  check_stack  (  label  ) 
register  char  ’label; 

{ 

if  (  pointer  !“  0  ) 

if  (  stremp!  stack[  pointer  -  1  1. label, 
return (  1  ) ; 

} 

return (  0  )  ; 

)  /*  check_stack  */ 


int  pull_stack(  ) 

( 

if  (  pointer  ! -  0  ) 

{ 

pointer — ; 

free(  stack [  pointer  ]. label  ); 
return (  1  ) ; 

) 

return (  0  )  ; 

}  /*  pull_stack  */ 


FILE:  etimer /library /statement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


void  statement (  label  ) 
register  char  ’label; 

{ 

)  /*  statement  */ 


FILE:  etimer/library/summary .c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
«  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 
♦include  <string.h> 
♦include  "list.h" 


extern 

extern 

extern 

extern 

extern 

extern 

extern 


LIST  *event_list; 
int  event_number; 
char  ’collapse (  ) ; 
char  ’duplicate!  ); 
char  ’list (  )  ; 
char  *type_name(  ); 
char  ’update!  ); 


static  void  update_event_number (  event  ) 
register  LIST  ’event; 

/ 

register  LIST  ’temporary; 
while  (  event  !=  0  ) 


label  )  ==  0  ) 
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( 

if  (  event->number  ==  0  ) 

( 

temporary  -  find_list(  event_list,  event->identifier,  "send_"  ); 
event->number  =  temporary->number; 

} 

event  =  event->next; 

1 

)  /*  update_event_number  */ 


static  void  update_dependt.it  (  event  ) 
register  LIST  ‘event; 

( 

register  char  ‘dependent  =  0; 
char  buffer!  256  ]; 

while  (  event  !=  0  ) 

{ 

if  (  event->identifier  »«  0  ) 

event->identif ier  =  duplicate!  ); 

if  (  strcmp!  event->type,  "program"  )  ==  Q  ) 

( 

dependent  =  0; 

) 

if  (  strcmp!  event->type,  "computation"  )  ==  0  ) 

{ 

event->dependent  =  dependent; 

sprintf!  buffer,  "%d",  event->number  ); 
dependent  =  duplicate!  buffer  ); 

) 

if  !  strncmp!  event->type,  "send_“,  strlen!  "send_"  )  )  ==  0  ) 

{ 

event ->dependent  «  dependent; 

sprintf (  buffer,  “%d",  event->number  ); 
dependent  =  duplicate!  buffer  ); 

) 

if  (  strncmp!  event->type,  "receive_",  strlen!  "receive  ”  )  )==  0  ) 

{ 

sprintf!  buffer,  "%d",  event->number  ); 

dependent  =  update!  dependent,  duplicate!  buffer  )  ); 

) 

event  *  event->next; 

} 

)  /*  update_dependent  */ 


static  void  output_event  list!  event  ) 
register  LIST  ‘event; 

( 

fprintf!  stdout,  "1  project  project  1  \"\"\n"  ); 

while  (  event  ! =  0  ) 

( 

if  (  event->dependent  0  ) 

event->depenaent  »  list!  collapse!  event->aependent  ),  ); 

if  !  strcmp!  event->type,  "program"  )  ==  0  ) 

( 

fprintf!  stdout,  "%d  program  %s  2  \"%s\"\n",  event->number,  event->identi f ier, 
event ->dependent  ); 

) 

if  (  strcmp!  event->type,  "computation"  )  ==  0  ) 
f 

fprintf!  stdout,  "%d  computation  %s  3  \"%s\"\n",  event->number,  list!  event- 
>identifier,  ),  event->dependent  ); 

) 

if  (  strncmp!  event->type,  "send_",  strlen!  ”send_"  )  )  ==  0  ) 

f 

fprintf!  stdout,  "%d  communication  %s  %d  %s  3  \"%s\"\n",  event->number,  event- 
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>identifier,  event->length,  type_name !  Sevent->type [  5  )  ),  event->dependent  ) 

) 

if  (  strncmp!  event->type,  “receive_",  strlen!  "receive  "  )  )  ==  0  ) 

{ 

) 

event  =  event->next; 

1 

)  /*  output_event_list  */ 


void  summary (  ) 

1 

♦ifdef  DEBUG 

fprintf!  stderr,  "pass  l:\n"  ); 
print_list(  stderr,  event_list  ); 
dendif 

update_event_number (  event_list  ); 
(I  ifdef  DEBUG 

fprintf (  stderr,  "pass  2:\n"  ); 
print_list (  stderr,  event_list  >; 
(tendif 

update_dependent (  event_list  ); 
♦ifdef  DEBUG 

fprintf (  stderr,  "pass  3:\n”  ); 
print_list(  stderr,  event_list  )  ; 
#endif 

output_event_li st (  event_list  ); 

)  /*  summary  */ 


FILE:  etimer/library/timer . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


((include  <stdio.h> 
((include  <string.h> 
♦include  "list.h" 


extern  int  level; 
extern  char  "update (  ); 


LIST  *event_list  =  0; 
int  event_number  =  1; 

static  int  state  =  0; 


void  program;  identifier  ) 
register  char  "identifier; 

( 

add_list(  Sevent_list,  identifier,  "program",  *+event_number,  0  ); 

state  =  0; 

)  /*  program  */ 


int  timer!  comment  ) 
register  char  "comment; 

( 

if  (  strncmp!  comment,  ""LOOP*",  6  )  !=  0  ) 

return (  0  ) ; 

if  (  strcmp!  comment,  ""LOOP*  PROLOGUE \n"  )  ==  0  ) 

( 
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label!  0  ); 
print_level (  level  ) ; 

margin_printf (  "CALL  timer_prologue ( ) \n"  ); 

state  =  0; 
return (  1  )  ; 

1 

if  (  strcmp!  comment,  "'LOOP*  STARTXn"  )  ==  0  ) 

( 

state  -  1 ; 
return (  1  )  ; 

) 

if  (  strcmp!  comment,  ""LOOP*  ST0P\n”  )  ==  0  ) 

( 

if  (  state  >==  2  ) 

< 

label (  0  ) ; 

,  rint_level (  level  ); 

marginprintf (  "CALL  stop  timer (%d) \n",  event  number  ); 

> 

state  »  C. 
return (  1  ) ; 

> 

if  (  strcmp!  comment,  ""LOOP*  EPILOGUEXn"  )  ==  0  ) 

( 

label (  0  ) ; 
print_level (  level  )  ; 

margin_printf (  "CALL  timer_epilogue () \n"  )  ; 

state  =  0; 
return (  1  )  ; 


return (  0  ) ; 
)  /*  timer  */ 


void  communication!  type,  identifier  ) 
register  char  "type; 
register  char  "identifier; 

( 

register  LIST  "event  =  end_list(  event_list  ); 

if  I  state  -=  2  ) 

( 

print_ievel (  level  ) ; 

margin_pr int f (  "CALL  stop_timer (%d) \n",  event  number  ) ; 
label (  0  ) ; 

( 

state  -  1; 

identifier!  strcspn!  identifier  ,  "()••  )  ]  =  '\0'; 

if  (  strcmp!  identifier,  event->identif ier  )  ==  0  ) 

{ 

event ->length+  +  , 1 
return; 

) 

if  (  strncmp!  type,  "senb_",  strien!  "send_"  j  )  ==  0  ) 

ada_Iist(  Sevent_iist,  identifier,  type,  ’■♦event_number,  1  ); 

if  (  strncmp!  type,  "receive_",  strien!  “receive_"  )  i  ==  0  ) 
add_list(  Sevent_list,  identifier,  type,  0,  1  ); 

)  /*  communication  */ 


void  computation!  identifier  ) 
register  char  "ident i f j er; 

( 

register  LIST  "event; 

switch  (  state  ) 

I 

case  1: 

print_ievel(  level  ); 
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margin_printf (  "CALL  start_timer (%d) \n",  ++event_number  ); 
label (  0  ); 

add_list(  sevent_list,  0,  "computation",  event_number,  0  )  ; 
case  2: 

if  (  identifier  !=  0  ) 

( 

event  =  end_list (  event_list  )  ; 

event->identif ier  =  update)  event->identif ier,  identifier  ) 

) 

state  =  2; 
break; 

} 

)  /*  computation  */ 


FILE:  et imer/1 ibrary/type. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
’  Author:  Stephen  R.  Wachtel 

'/ 


extern  char  "merge)  ); 


char  "type)  type_name,  optional_type_length  ) 

register  char  "type_name; 

register  char  *optional_type_length; 

< 

if  (  optional_type_length  !  =  (char  *)0  ) 

return)  merge)  "ts%s”,  type_name,  optional_type_lengtn  )  ); 

else 

return)  tvpe_name  ); 

)  /*  type  */ 


FILE:  etimer/library/type_name. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


•include  <stdio.h> 
•include  <string.h> 


char  *type_name(  message_type  ) 
register  char  *message_type; 

( 


if 

(  stremp)  "character  08bit‘ 
return)  "character'l"  ); 

",  message_type 

) 

««  0 

if 

(  r  remp (  "comp. ex  32o.t“, 
return)  "complex's"’’  >; 

message  type  ) 

0  ) 

if 

(  stremp)  "complex  S’ibit", 
return)  "complex*16"  ); 

message  type  ) 

a  i 

if 

(  stremp!  "logical  08bit", 
return)  "logical'l"  ); 

message_type  ) 

-- 

0  ! 

;  * 

(  stremp)  "logical  16bit", 
return)  "logical*2”  ); 

message_type  ) 

” 

0  ) 

if 

(  stremp)  "logical  32bi^". 
return)  "logical"1)"  ); 

message_type  ) 

0  ) 

,  * 

(  stremp {  "real_32bitM,  messa;t_type  )  == 
return  (  Mreal*4"  ); 

0 

) 

\  f 

(  stremp (  "real_64bit ",  message  tyr-  /  =- 
return (  "real *8”  ); 

0 

) 
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if  (  strcmp(  "signed_08bit",  message_type  )  ==  0  ) 
return!  ”integer*l"  ); 

if  (  strcmp!  "signed_16bit",  message_type  )  ==  0  ) 
return!  "integer*2"  ); 

if  (  strcmp!  "signed_32bit " ,  message_type  )  ==  0  ) 
return!  "integer**!"  ); 


if  (  strcmp!  "unsigned_08bit" ,  message_type  )  ==  0  ) 
return!  "unsigned  integer'l"  ); 
if  (  strcmp!  "unsigned_l 6bit" ,  message_type  )  ==  0  ) 
return!  "unsigned  integer*2"  ) ; 
if  (  strcmp!  "unsigned_32bit",  message_type  )  ==  0  ) 
return!  "unsigned  integer*4"  ); 

fprintf !  stderr,  "ERROR:  unrecognized  message_type  ' %s'\n",  message_type  ); 
exit  (  -1  ) ; 

!  /*  type_n ame  */ 


FILE:  etimer/library/update.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 
♦include  <string. i> 


extern  char  "merge!  )  ; 
extern  char  "parse!  j; 


char  "update!  input_list,  identifier  ) 
register  char  *input_list; 
register  char  "identifier; 

; 

register  char  "input; 
register  char  *output_l i st ; 
register  char  "output; 

if  (  identifier  ==  (char  *)NULL  ) 
return!  input_list  ); 

output_list  =  (char  *)NULL; 

while  (  (  input  =  parse!  input  list  )  )  !-  (char  "(NULL  ) 

( 

if  (  strcmp!  input,  identifier  )  ==  0  ) 
identifier  =  (char  *)NULL; 

if  (  output_list  !=  (char  *>NULL  ) 

( 

output  =  merge!  "%s(%sj",  output_list,  input  ); 
free!  output_list  ); 

) 

else 

output  =  merge!  "{%s)",  input  ); 

free!  input  ); 
output  i 1st  “  output; 


if  (  identifier  (char  *)NULL  ) 
return!  output_list  ); 


if  ‘  output_list  !=  (char  * ) NULL  ) 


output  -  merge!  "%s{%s)",  output_iist,  identifier  ) ; 
free!  output_list  ); 

e  1  se 

output  =  merge!  identifier  ); 


output  i ; st 


output; 
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return)  output_list  ); 
)  /*  update  */ 


FILE:  etimer/library/yyerror.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  T  chnology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


#include  <stdio.h> 


extern  int  yylineno; 


void  yyerror!  string  ) 
register  char  ‘string; 

( 

fprintf!  stderr,  "line  %d,  %s\n",  yylineno,  string  ); 

exit (  -1  ) ; 
t  /*  yyerror  */ 


FILE:  etimer/library/yygetc.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


((include  <stdio.h> 
((include  <ctype.h> 


extern  int  yylineno; 


int  tab(  length  ) 
register  int  length; 

{ 

while  (  length —  !=  0  ) 
yyunput (  '  '  ) ; 

return!  ’  '  ); 

}  /*  tab  */ 


int  yygetc!  file  ) 
register  FILE  ‘file; 

! 

int  c; 

int  column (  6  )  ; 

loop: 

•  f  (  i  c  =  getc(  file  )  )  ==  ' \t  '  ) 

c  =  tab (  6  ) ; 


if 

{  c  ! =  ' \n ' 

) 

return  (  c  ) 

■ 

if 

<  (  column{ 

0 

=  getcf 

file  ) 

)  '  = 

goto  abort 

0; 

i  f 

(  (  column [ 

1  I 

=  getc ( 

file  ) 

)  !  = 

goto  abort 

1; 

i  f 

(  (  column [ 

'2  ] 

=  getc! 

file  ) 

1  '  = 

goto  abort 

2; 

i  f 

(  (  ^.olumn( 

3  1 

=  getc! 

file  ) 

)  :  = 

goto  abort 

3; 

i  f 

<  (  column { 

< 

=  getc! 

file  ) 

)  ’  = 

goto  aborts; 
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if  (  isspace!  column 
goto  abort_5; 

yylineno++; 
goto  loop; 

abort_5 : 

if  (  column!  5  )  «« 
tab (  1  ) ; 
else 
< 

yyunput (  column! 
if  (  column!  5  ] 
yylineno++; 

) 

abort_4 : 

if  (  column!  4  ]  == 
tab!  2  ) ; 
else 
( 

yyunput!  column! 
if  (  column!  4  ] 
yylineno++; 

) 

abort_3 : 

if  (  column!  3  ]  == 
tab!  3  ) ; 
else 
.  ( 

yyunput!  column! 
if  (  column!  3  ] 
yylineno++; 

) 


5  ]  =  getc(  file  )  )  ) 

\f  ) 

5  ]  ); 

■=»  1  \n '  ) 

■  \t  •  ) 

4  ]  >; 

==  ' \n '  ) 

•\f  ) 

3  ]  ) ; 

==  1 \n '  ) 


abort_2 : 

if  (  column!  2  ]  ==  '\t'  ) 
tab!  4  ) ; 
else 
( 

yyunput!  column!  2  ]  ); 
if  (  column!  2  1  --  *\n'  ) 
yylineno+ ‘ ; 

1 

abort_l : 

if  (  column!  1  1  --  '  \ t  •  ) 
tab (  5  ) ; 

else 

! 

yyunput!  column!  1  ]  ); 

if  (  column!  1  )  ==  '\n'  ) 
yylineno++; 

) 


if  (  column!  0  )  ==  ’\t*  ) 
tab (  6  )  ; 

el  se 
{ 

yyunput!  column!  0  ]  ); 
if  (  column!  0  ]  ==  '\n'  ) 
yy  1  i  neno+-‘; 


return (  c  ) ; 
i  /*  yygetc  */ 


FILE:  et imer / 1 i brary /yywrap .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 
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int  yywrapt  ) 

{ 

return (  1  ) ; 
1  /*  yywrap  */ 


FILE:  etimer/scanner. 1 


*( 

/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 

%> 


%a  10000 
%e  10000 
%k  10000 
%n  10000 
%  o  10000 
%p  10000 


a  [aA] 
b  [bB] 
c  [cCJ 
d  [dD] 
e  [eE] 
f  [fF] 

g  tgG] 

h  [hH] 
i  [ill 
j  [jJ] 

k  [kK] 
1  [1L] 

m  [mMJ 
n  [nN  j 
o  [oO] 
P  tpPJ 
q  [qQl 
r  [rR] 
s  [SS] 
t  [tT] 
u  [uU] 
v  [W] 
w  [  wWJ 
x  [xX  j 

y  [yY] 

Z  [ZZ] 


%{ 

♦include  "gramma.. h" 
extern  char  •yylval; 


♦undef  YYLMAX 
♦define  YYLMAX  (256*20) 


extern  cna r 
extern  char 
extern  char 
extern  char 

*) 


•duplicate (  )  ; 
•hoiierith (  )  ; 
*nor,_blank(  )  ; 
•alias!  )  ; 


A r\*cC) .• (\n)  I 
*i\  :*(\n]  { 

♦ifdef  DEBUG 
ECHO; 

♦  en.di  f 

yylvai  =  duplicate!  yytext  ); 
return.  I  COMMENT  ); 
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> 


[\  1  ( 

#ifdef  DEBUG 
ECHO; 
lendif 

/*  return!  ' \  1  )  */; 

) 


[\*J  { 

itifdef  DEBUG 
ECHO; 

#endif 

return (  ' \s •  ) ; 

) 


t\()  < 

lifdef  DEBUG 
ECHO; 
lendif 

return (  1 \ ( 1  ) ; 

) 


[\>  1  ( 

#ifdef  DEBUG 
ECHO; 
lendif 

return (  ' \) '  ) ; 

) 


r\*j  ( 

# i f def  DEBUG 
ECHO; 
ftendi  £ 

return (  ' \* '  ) ; 

) 


(\*][\*1  ( 
lifdef  DEBUG 
ECHO; 
lendif 

return  (  EXPONENTIATE  ) ; 

) 


[\  +  l  ( 

lifdef  DEBUG 
ECHO; 
lendif 

return (  ' \+  *  ) ; 

} 


[\,  1  ( 

lifdef  DEBUG 
ECHO; 
lendi f 

return (  ' '  ) ; 

) 


[\-l  ! 

lifdef  DEBUG 
ECHO; 
lendif 

return (  1 \- '  ) ; 

) 


[  \  - 1  ( 
lifdef  DEBUG 
ECHO; 
lendi  f 

return  (  •  \  .  •  ) ; 

l 
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t\/l  ( 
lifdef  DEBUG 
ECHO; 
tendif 

return (  '\/'  ); 

) 


[\:]  ( 
lifdef  DEBUG 
ECHO; 
lendi f 

return (  ' \ : 1  )  ; 

} 


[\=]  l 
lifdef  DEBUG 
ECHO; 
lendif 

return!  '\«'  ); 

) 


[\n]  { 

lifdef  DEBUG 
ECHO; 

«endi f 

/*  return!  '  \n‘  )  */; 

1 


[\t]  1 

lifdef  DEBUG 
ECHO; 
lendif 

/*  return!  *\t'  )  */; 

) 


[\.](a)inHdH\.l  ( 

lifdef  DEBUG 
ECHO; 
lendi f 

return!  RW_AND  ); 

1 


[\.Jfe){q)[\.l  { 

lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_EQ  ) ; 

) 


[\.](e](qi(vH\.|  ( 

lifdef  DEBUG 
ECHO; 
lendi f 

return!  RW_EQV  ); 


! \ . ) i f  M  a  H 1 K  s )( e )  [  \ .  ]  { 

lifdef  DEBUG 
ECHO; 
lendi c 

return!  RWFALSE  ); 
t 


[\. ! fg) (e) [\.J  ( 
lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_GE  ) ; 

) 
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[\.lfg)(t)[\.l  { 
tifdef  DEBUG 
ECHO; 
tendif 

return <  RW_GT  ) ; 

) 


[\.)UHeH\.]  { 
tifdef  DEBUG 
ECHO; 

#endif 

return  (  RW_LE  ) ; 

) 


[\.](lHt)[\.l  { 

#i fdef  DEBUG 
ECHO; 

#endif 

return (  RW_LT  ) ; 

) 


[\-l (n>(e| [\ . ]  ( 

#ifdef  DEBUG 
ECHO; 
tendif 

return (  RW_NE  ) ; 

} 


[\. ] (n) (e) (q> (v> [\.  ]  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

return)  RW_NEQV  ); 

) 


[\.){n){o){t)[\.]  ( 

#i fdef  DEBUG 
ECHO; 

#endif 

return (  RW_NOT  ) ; 

} 


[\.]<oHr>[\.)  ( 

#ifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_OR  ) ; 


[\.] (tl(r){u)(el[\.|  ( 

tifdef  DEBUG 
ECHO; 
iendi  f 

return (  RW_TRUE  ) ; 

> 


iaits)(s){i};g)in>  ( 

tifdef  DEBUG 
ECHO; 
tendi f 

return!  RW_ASSIGN  ); 

) 


{b)(a)(c){k){s}{p|(a)(c}(e}  f 
tifdef  DEBUG 
ECHO; 
tendi f 

return!  RW_BACKSPACE  ); 

( 
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(bHlKol(cl(k)[\  JMdHaHtHa}  ( 
tirdef  DEBUG 
ECHO; 

#endif 

return (  RW_BLOCK_DATA  ) ; 

) 


(cMildHU  { 

#ifde£  DEBUG 
ECHO; 

#endif 

return {  kW_CALL  ) ; 

) 


(cMhHaHrHaHcHtHeHr)  { 
#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_CHARACTER  )  ; 

) 


(c)(l)(o)(s}<e)  ( 

#i fdef  DEBUG 
ECHO; 

#endif 

return (  RW_CLOSE  ); 

} 


(c) {o} (m) (m|{o| { n >  ( 

#ifdef  DEBUG 
ECHO; 
tendif 

return  (  RW_COMMON  ) ; 

1 


(cMoHmllpHlHellxl  { 
#ifdef  DEBUG 
ECHO; 

#endif 

return  (  RW  COMPLEX  ) ; 

) 


(c)(0) { n  > { t ) {i)(n|{u){e)  { 

#ifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_CONTINUE  ) ; 

) 


(d) (a) ( t ) (a)  { 

#i fdef  DEBUG 
ECHO; 

#endi  f 

return (  RW_DATA  ) ; 

) 


!d)(i)(m)(e)(n)(s)(i)(o)(n)  ( 

Kifdef  DEBUG 
ECHO; 

Hendi f 

return!  RW_DIMENSION  ); 

) 


(d)(0)  ( 

#ifdef  DEBUG 
ECHO; 

#endi  f 

return!  RK_DO  ); 

) 


id)(o)(u)(b)(l)(e)[\  i * ( p i ( r i ( e ) ( c ) ( i } i s )i  i ) ( o )  (  n )  ( 
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Iifdef  DEBUG 
ECHO; 
lendif 

return <  RW_DOUBLE_PRECISION  ); 

> 


(eHDIs)le)  { 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_ELS£  ); 

) 


(eXltlsHe)  [\  { 

Iifdef  DEBUG 
ECHO; 

#endif 

return (  RW_ELSE_IF  ) ; 

} 


(e)lnMd)  { 

Iifdef  DEBUG 
ECHO; 
lendif 

return (  RW_END  ) ; 

} 


(e){n){d) [\  ) * ( i } { f }  ( 

Iifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_END_IF  ) ; 

) 


(e)(n|(d)(f}|i)|l){e)  ( 

Iifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_ENDFILE  ); 

} 


(eHn)|t}(r||y)  { 

Iifdef  DEBUG 
ECHO; 
lendif 

return (  RW_ENTRY  ) ; 

) 


(e)(q>(u>|i)(v)(a)|l)(e)(n)(c)(e>  ( 
Iifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_EQU  I  VALENCE  )  ;. 

) 


{ e ) ( x !{ t ! { e ; f  r } ( n } { a } { i  }  f 
Iifdef  DE3UG 
ECHO; 
lendif 

return!  RW_EXTERNAL  ); 

) 


{f)(o){rHm)fa)(t).*  ( 

Iifdef  DEBUG 
ECHO; 
lendif 

yylval  =  duplicate!  yytext  ); 
return!  RW_FORMAT  ); 

) 


!  f  H  u  I  ( n  !  (  c )  1 1 )  (  i  )  !  o )  ( n } 
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Iifdef  DEBUG 
ECHO; 
lendif 

return (  RW_FUNCTION  ); 

) 


ig>(o) [\  l*lt)(o)  { 

Iifdef  DEBUG 
ECHO; 
lendif 

return (  RW_GO_TO  ) ; 

) 


{  i  }  {  f  1  { 

Iifdef  DEBUG 
ECHO; 
lendif 

return (  RW_IF  ) ; 

) 


(i)(ni)(p)(l)(i)(c)(i)(t)  { 

Iifdef  DEBUG 
ECHO; 
lendif 

return (  RW_IMPLICIT  ) ; 

> 


(iHnHcHUIuMdUe)  ( 
Iifdef  DEBUG 
ECHO; 
lendi  f 

return (  RW_INCLUDE  ); 

) 


(iHn!(qHu!|i)|r)(e}  { 

Iifdef  DEBUG 
ECHO; 
lendif 

return (  RW_INQUIRE  ); 


(iHn)(t}{el(gHe)|r|  ( 
Iifdef  DEBUG 
ECHO; 
lendif 

return (  RW_INTEGER  ); 

) 


(i)(n)(t}(r){i)(n){s>(i)(c)  { 

Iifdef  DEBUG 
ECHO; 
lendi f 

return (  RW_INTRINSIC  ) ; 

) 


CHoHglliHcHalUt  ( 
Iifdef  DEBUG 
ECHO; 
lendif 

return)  RW_LOGICAL  ); 

) 


(n)(a)(m)(e}(i|(i)(s)(t)  { 

Iifdef  DEBUG 
ECHO; 
lendi f 

return)  RW_NAMELIST  ); 

1 


(  o  i)  p }  )  e )  (  n  ) 
Iifdef  DEBUG 


! 
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ECHO; 

fendif 

return (  RW  OPEN  ) ; 

) 


(pl|aHrHaHm)(e|{t)(ellr)  { 
Hifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_PARAMETER  ) ; 

) 


fpHaHuHsHe)  { 

# i f def  DEBUG 
ECHO; 

#endif 

return (  RW^PAUSE  ) ; 

) 


(pHr}|i)(n)|t|  ( 

It  if  def  DEBUG 
ECHO; 

#endif 

return  (  RW_PRINT  ) ; 

) 


(p)  !  r )  |o)  (gH  r)  (a)  (m)  ( 

Hi fdef  DEBUG 
ECHO; 

#endi  f 

return  (  RW_PROGRAM  ) ; 

) 


(r)(e)(a){d)  { 

#i fdef  DEBUG 
ECHO; 

Hendif 

return (  RW_READ  ) ; 

) 


(rl(e)lalll)  ( 

# i f def  DEBUG 
ECHO; 

#endi  f 

return (  RW_REAL  ) ; 

} 


(r)  (e)  (t)  (uHr)  (n)  ( 

# i fdef  DEBUG 
ECHO; 

#endi  f 

return (  RW_RETURN  ) ; 

1 


{r){e)(w)(i){n){d}  ( 

•ifdef  DEBUG 
ECHO; 

•end; f 

return!  RW_REWIND  ); 

> 


{  s  '  (  a  }  <  v )  {  e )  i 
•ifdef  DEBUG 
ECHO; 

•  endi  f 

return!  RW  SAVE  ); 


islitliollpl 
•ifdef  DEBUG 
ECHO; 
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#endif 

return (  RW_STOP  ); 

1 


(s|{u!(bl(rl(o!(uKtHil(n((ei  { 
lifdef  DEBUG 
ECHO; 

#endif 

return (  RW_SUBROUTINE  )  ; 

) 


(tllh)lellnl  ( 

(tifdef  DEBUG 
ECHO; 

#endif 

return (  RW_THEN  ) ; 

) 


(t)(o)  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_TO  ); 

} 


IwlIrHiUtlle)  ( 
tifdef  DEBUG 
ECHO; 

#endif 

return (  RW_WRITE  ); 

) 


(uHnHd)  (e)(f  )U)fnHe)fd>  { 

# i f def  DEBUG 
ECHO; 

(tendif 

return (  RW_UNDEFINED  ); 

) 


[%a-zA-Z] [_a-zA-Z0-9]*  1 
# i fdef  DEBUG 
ECHO; 

(lendi  f 

yylval  =  duplicate!  alias!  yytext  )  ); 
return!  IDENTIFIER  ); 

) 


"fO-9  J  r  0-9  110-9  1  [ 0-9  ][0-9  ][\  )  ( 

Kifdef  DEBUG 
ECHO; 

#endi  f 

yylval  =  duplicate!  non_blank(  yytext  )  ); 
return!  LABEL  ); 

) 


[0-9X  I 

'C-9; */\.  [ a-zA-Z ;  +  \  .  < 

»;Joel  DEBUG 
ECHO; 

(tend!  f 

yylval  =  duplicate!  yytext  ); 
return!  INTEGER  ); 


[0-9] +\. [0-9] * ( [eE] [\+\-] ? [0-9] +) ? 
f0-91*\.(0-9]*(feE)[\+\-I?[0-9I+)? 
[0-9]  +  I [eE]  [\+\-] ? [0-9] +) ?  ( 

(tifdef  DEBUG 
ECHO; 

Kendi  f 

yylval  =  duplicate!  yytext  ); 
return (  REAL  ) ; 
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> 


[0-9] +\. [0-91*  <[dD] [\+\-J  ? [0-9J  +  ) ?  I 
[0-9]*\.  [O-95  +  UdD]  [\  +  \-]  ? [ 0-9]  +)  ?  ! 

[0-9]  +  ([dD]  [\+\-]?[0-9]+)?{ 

#ifdef  DEBUG 
ECHO; 

#endi£ 

yylval  “  duplicate (  yytext  ); 
return!  DOUBLE_PRECISION  ); 

) 


\  ■  [''X '  ]  *\ *  I 

\"r\-]*\"  { 

#ifde£  DEBUG 
ECHO; 

#endif 

yytext [  0  ]  =  ' \ ; 

iytextf  strlen!  yytext  )  -  1  ]  »  ■ \*'; 
yylval  =  duplicate!  yytext  ); 
return!  STRING  ); 

) 


[0-9] + [hH]  { 
iifdef  DEBUG 
ECHO; 

#endif 

yylval  =  duplicate!  hollerith!  yytext,  'V*  i  ); 
return!  HOLLERITH  ); 

) 


FILE:  etimer/statement/Makefile 


# 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


CC  =  cc  -g 
INCLUDE  =  ../include 
CFLAGS  =  -IS (INCLUDE) 
LIBRARY  =  statement. a 


OBJECTS  =  \ 

ari thmetic_i f_statement . o  \ 
assign_statement . o  \ 
assigned_go_to_statement . o  \ 
assignment_statement . o  \ 
backspace_statement . o  \ 
block_data_statement . o  \ 
block_i f_statement . o  \ 
cal l_statement . o  \ 
close_statement . o  \ 
comment_statement . o  \ 
common_statement . o  \ 
computed_go_to_statement . o  \ 
cont  l  r,ue_st atement .  o  \ 
data_statement . o  \ 
decl arat ion_statement . o  \ 
dimension_statement . o  \ 
do_statement . o  \ 
e 1 se_i f_st atement . o  \ 
e  se_statement .  o  \ 
end_\ f_statement . o  \ 
end_statement . o  \ 
endf ile_statement . o  \ 
ent ry_statement . o  \ 
equ i va lence_statement . o  \ 
externa l_statement . o  \ 
f ormat_statement . o  \ 
f ur.ct  i  on_statement .  o  \ 
impl i c i t_st atement . o  \ 
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include_statement . o  \ 
inquire  statement. o  \ 
intrinslc_statement . o  \ 
logical_if_statement . o  \ 
namelist_statement.o  \ 
open_statement . o  \ 
parameter_statement . o  \ 
puuse_statement . o  \ 
print_statement . o  \ 
program_statement . o  \ 
read_statement . o  \ 
return_statement . o  \ 
rewind_statement . o  \ 
save_statement . o  \ 
stop_stacement . o  \ 
subrout ine_statement . o  \ 
unconditional_go_to_statement . o  \ 
write  statement. o 


$ (LIBRARY) : S (OBJECTS) 
rm  -f  $ (LIBRARY) 
ar  crv  $ (LIBRARY)  $ (OBJECTS) 
ranlib  $ (LIBRARY) 


.SUFFIXES:  .c  .o 
.  c .  o : 

S (CC)  -c  $ (CFLAGS )  $< 


clean : 

rm  -f  S (LIBRARY)  $ (OBJECTS) 


FILE:  etimer/statement/arithmetic  i e  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

»  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  *list(  ); 


void  ai .thmetic_if_statement (  expressior,  label_list  ; 
register  char  "expression; 
register  char  *label_list; 

( 

print_level (  level  )  ; 

margin_printf t  "IF  <%s)  %s\n",  expression,  list!  label_list,  ",  ”  )  ); 

)  /*  ar i t hmet i c_i f  statement  */ 


FILE:  etimer/ s  .atement / a ssign_st atement . c 


/* 

'  Copyright  1991 

■  Georgia  Institute  of  Technology 
•  Computer  Engineering  Researcr.  Laboratory 
'  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 


void  assign_statement  (  label,  identifier  ) 
regi  ter  char  "label; 
register  char  "identifer; 

pr ; r r _ 1 e ve !  (  level  ); 

ma  rq  i  r.  pri  nt  f  (  "ASSIGN  %s  TC  Is’rT,  .ar  ,,  identifier  ); 
1  •' *  assign  statement  */ 


1 3.  Appendix  H:  etimer  program  source 


269 


FILE :  et imer/ statement /as signed_go_t o_s t atement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  "list(  ); 


void  assigned_go_to_statcment (  identifier,  optional_label_list  ) 
register  char  "identifier; 
register  char  "opt i onal_label_li st ; 

{ 

if  (  opt ional_label_l i ""  !=  0  ) 

( 

print_leve]  (  level  )  ; 

margin_printf  (  "GO  TO  %s,  (%s)\n”,  identifier,  list(  optional_laut-] 


print_ievel  (  level  ) ; 

margir._printf  (  "GO  TO  %s\n“,  identifier  ); 

i 

/'  assigned_gc_to_statement  "/ 


FILE:  et imer /statement / assignment_st atement . c 


/* 

*  Copyrigh"  1991 

*  Georgia  Institute  of  Technology 

’  Computer  Engineering  Research  Laboratory 
"  Author:  Stephen  R.  Wachtel 

"/ 


extern  int  level; 


void  assignment_statement (  variable,  expression  ) 
register  char  "variable; 
register  char  "expression; 

{ 

print  level .  level  ); 

margin  print! (  "%s  *  %s\n",  variable,  expression  ); 
'•  /*  assignment  statement  */ 


FILE:  etimer/ statement  /oacxspacestato:  er. t  .c 


/* 


Copyright  1991 

Georgia  Institute  of  Technology 


e x  t e  r r.  i  r. t  i  e  ve 
ex'.err  c h a  r  *  I  i 


t  (  )  ; 


'i  Ld';< 


iterer.G 


v_  level  f  ,f"/o  i  )  ; 


list,  ”,  M  ) 
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/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
’  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 


void  biock_data_statement (  identifier  ) 
register  char  ‘identifier; 

1 

print_level (  level  )  ; 

margin_printf (  "BLOCK  DATA  %s\n",  identifier  ); 
)  /*  block  data  statement  */ 


FILE:  etimer/statement/block  if  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
‘  Author:  Stephen  R.  Wachtel 

’/ 


extern  int  level; 


void  block_i f_statement (  expression  ) 
register  char  ‘expression; 

{ 

print_level<  level  ); 

margin_print f (  "IF  (%s)  THENXn",  expression  ); 
ievel++; 

i  /*  block  if  statement  */ 


FILE:  et im.er/ statement /call  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Engineering  Research  Laboratory 
’  Author:  Stepnen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  *list(  ); 


void  call  statement!  identifier,  options 
register  char  ‘identifier; 
register  char  'opt icnai_actuai_argument__ 

.f  '  opt i ora ._actua._argumert_l . st  ’=  Z  , 
pr.r.t_level  (  .eve.  ); 

margin_printf  (  "CALL  %s(%s)  n",  iaer.tif.er,  list!  opt  i  era  1  act  ua  1  argument  .is;, 
",  "  i  )  ; 

else 

eve.  (  level  ) ; 

print  f  I  "CALL  %s!)  .r  ",  .certifier  j  ; 

*  call  state-er.t  */ 


l_actua l_a rgurnent  1 i st  ) 
lust; 
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/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  *list(  ); 


void  close_statemenL (  control_list  ) 
register  char  *control_list; 

{ 

print_level (  level  ); 

margin_printf (  "CLOSE  !%s)\n",  list(  control_list,  ”,  "  )  ); 
)  /*  close_statement  */ 


FILE:  etimer/statement/comment  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


void  comment_statement (  string  ) 
register  char  'string; 

{ 

margin_printf (  "%s“,  string  ); 
)  /*  comment_statement  */ 


FILE:  etimer/statement/common  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
'/ 


extern  int  level; 
extern  char  'parse (  ); 
extern  char  *list(  ); 


void  common_statement (  optional_common_name,  common_list  ) 
register  char  *optional_common_name; 
register  char  * common_l i st ; 

i 

register  char  'common; 

register  char  'identifier; 

register  char  *optional_subscript_list; 

print_level (  level  ) ; 
margin_printf (  "COMMON  "  ); 

.f  (  opt  i  ona  ._common_name  Z  ) 

marai n_pr i nt f (  "/%s/  ",  cpt i onal _common_name  ); 

while  (  common  =  parse!  common_list  !  ) 

i 

identifier  =>  parse!  common  ); 

optional  subset ipt_l i st  -  parse!  common  ); 

margin  printf (  "%s",  identifier  ); 
if  (  opt i ona i _subscr i pt_ I i st  !=  0  ) 

ma rgi n  pr i nt f (  "(%s)",  list!  opt i ona 1 _subsci ipt_l i st ,  ",  "  )  ); 

if  !  strlen!  common_iist  }  ■-  C  } 

marg; n  printf!  ",  "  ) ; 
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margin_printf (  "\n"  )  ; 
)  /*  common  statement  */ 


FILE:  etimer/ statement /computed_go_to_statement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  *list(  ); 


void  computed_go_to_statement (  label_list,  expression  ) 
register  char  *label_list; 
register  char  ‘expression; 

( 

print_level (  level  ) ; 

margin_printf <  ”G0  TO  (%s)  ,  %s\n",  list (  label_list,  ",  "  ),  expression  ) 
}  /*  computed_go_to_statement  *./ 


FILE:  etimer/statement/continue  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 


void  continue_statement (  ) 

( 

print_level (  level  )  ; 
margin  printff  "CONTINUE\n"  ); 
)  /'  continue_statement  */ 


FILE:  etimer/statement/data  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  ‘parse  (  ); 
extern  char  *list(  ); 


void  aata_statement (  data_list  ) 
register  char  *data_list; 

1 

register  char  ‘data; 
register  char  *variable_li st ; 
register  char  ' constant_l i st ; 

print_level (  level  ) ; 
margin_printf (  "DATA  ”  >; 

while  (  data  -  parse!  datalist  )  ) 


variable  list  =  parse ( 

data  ) ; 

constant  list  *  parse! 

data  ) ; 

margin  p r i n t  f {  " % s  / % s . 

'**,  list/  va:  -  ar- 1  o  ] 

i  s t. ,  ”, 

”  )  ,  .13'  1 

1  constant 
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)  ; 


} 


if  (  strlen(  data_list 
margin_printf  (  ",  " 


margin_printf (  "\n"  ); 
}  /*  data  statement  */ 


0  ) 


FILE:  etimer/statement/declaration  statement.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  "parse (  ); 
extern  char  "list!  ); 


void  declaration_statement (  type,  declaration_list  ) 

register  char  "type; 

register  char  "declaration  list; 

( 

register  char  "declaration; 

register  char  "identifier; 

register  char  "optional_subscript_list; 

print_level (  level  ) ; 
margin_printf (  "%s  ",  type  ); 

while  (  declaration  =  parse)  declaration_list  )  ) 

{ 

identifier  =  parse!  declaration  ); 

optional_subscript_list  =  parse!  declaration  ); 

margin_printf (  "%s",  identifier  ); 

if  (  optional  subscript_list  0  ) 

margin_prfntf (  "(%s)",  list!  optional_subscript_list,  “,  "  )  ); 

if  (  strlen!  declaration_list  )  !=  0  ) 

margin_printf (  ",  "  ); 

) 

margin_printf (  "\n"  ); 

)  /*  declaration  statement  */ 


FILE:  etimer/statement/dimension  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Commute"  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  "parse!  ); 
extern  char  "list!  ); 


void  dimension_statement (  dimension_l i st  ) 
register  char  *dimension_l i st ; 
f 

register  char  "dimension; 
register  char  "identifier; 
register  char  * subscr ipt_l i st ; 

print_level(  level  ); 

ra r^: n_pr i nt f *  "LI  MENS  ION  "  ); 

while  (  dimension  ~  parse!  o:mensicr.  .is:  )  ) 
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{ 

identifier  -  parse)  dimension  ); 
subscript_list  =■  parse)  dimension  ); 

marginprintf (  "%s(%s)",  identifier,  list)  subscript_list,  ",  "  )  ); 

if  (  strlen)  dimension_list  )  !=  0  ) 
margin_printf (  ",  "  ) ; 

) 


margin_printf (  "\n"  ); 

)  /*  dimension  statement  */ 


FILE:  etimer/statement/do  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

’  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  "list)  ); 


void  do_statement (  label,  identifier,  expression_list  ) 
register  char  "label; 
register  char  "identifier; 
register  char  *expression_list; 

{ 

push_stack(  label  ); 
print_level (  level  )  ; 

margin_printf (  "DO  %s  %s  =  %s\n",  label,  identifier,  list)  expression_list,  ",  "  )  ) 
level++; 

)  /*  do  statement  */ 


FILE:  etimer/statement/else  if  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 


void  el s“ _i f_statement (  expression  ) 
register  char  "expression; 

f 

level  — ; 


print_level (  level  ) ; 

margin_pr:  ntf  (  "ELSE  IF  ) % s )  THEN\r." ,  expression  ); 
level  ■»  +  ; 

/  /*  else  if  statement  */ 


FILE:  etimer/statement/else  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  laboratory 
“  Author:  Stephen  R.  Wachtel 

*/ 


ex  - e  rr 


level ; 
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void  else  statement (  ) 

f 

level--; 

print_level (  level  ); 
margin_printf  (  "ELSE\n"  ) ; 

level++; 

}  /*  else  statement  */ 


FILE:  etimer/statement/end  if  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 


void  end_if_statement (  ) 

{ 

level --; 

print_level (  level  )  ; 
margin_printf (  “END  IF\n"  ); 
}  /*  end_if_statement  */ 


FILE:  etimer/statement/end  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 


void  end_statement (  ) 

f 

print_level (  level  )  ; 
margin_print f (  "END\n"  ); 
)  /*  end  statement  */ 


FILE:  et imer /statement /endfi le  statement. c 


/* 

*  Copyrignt  1991 

*  Georgia  Institute  of  Technology 

*  Ccmp.’ter  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

'/ 


extern  int  level; 
extern  char  *list(  ); 


void  endf ile_statement (  control_list  ) 
register  char  *cont rol_l i st ; 

( 

print_level (  level  )  ; 

margi n_pr i nt f (  "ENDFILE  (%s)\n”,  list!  cont rol_i i st,  ",  "  )  ); 
}  /*  endfile  statement  */ 


FILE:  etimer / statement /ent ry  statement . c 
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/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  ‘list (  )  ; 


void  entrystatement (  identifier,  optional_formal_argument_list  ) 
register  char  ‘identifier; 

register  char  *optional_f ormal_argument_list; 

( 

if  (  optional_formal_argument_list  !=  0  ) 

{ 

print_level (  level  ) ; 

margin_printf (  "ENTRY  %s(%s)\n",  identifier,  list(  optional_formal_argument_list, 

) 

else 

( 

print_level (  level  )  ; 

margin_printf (  "ENTRY  %s()\n",  identifier  ); 

) 

)  /*  en..  ry_statement  */ 


FILE:  etimer/statement/equi valence_statement  .c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  ‘parse (  ); 
extern  char  *list(  ); 


void  equivalence_statement (  equivalence_l i st  > 
register  char  *equivalence_list; 
f 

register  char  ‘variable_list; 

print_level (  level  ) ; 
margin_printf (  "EQUIVALENCE  "  ); 

while  {  variable_list  =  parse!  eq  :ivalence_list  )  ) 

< 

margin_print f (  "(%s)“,  list!  variable_list,  ”,  "  )  )  ; 

if  (  strlen!  equivalence_list  )  !-  0  ) 

margin_print f (  ",  "  ); 

) 

marair_print f (  "\n"  ); 

;  /*  equi vaience_siatemeni  */ 


FILE:  et ime r/ statement /external  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  ‘list!  ); 
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void  external_statement (  external_list  ) 
register  char  ‘external  list; 

( 

print_level (  level  ); 

margin_printf (  "EXTERNAL  %s\n",  list(  external_list,  ",  "  )  ); 
1  /*  external  statement  */ 


FILE:  etimer/statement/format  statement. c 


/" 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
’  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 


void  f ormat_statement (  format  ) 
register  char  "format; 

i 

format [0)  =  'F‘; 
format [1)  *  'O'; 
format [2]  =  'R' ; 
format  [ 3 ]  =  ' M'  ; 
format[4]  =  'A'; 
f  o  rma  t [ 5 ]  =  '  T ' ; 

print_level (  level  ) ; 
margin_printf (  "%s\n",  format  ); 
}  /*  f ormat_statement  */ 


FILE:  etimer/statement/function  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
’  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  "list!  ); 


void  function_statement  (  optional_type,  identifier,  optional_formai_argument_li.*t  ) 
register  char  *optional_type; 
register  char  "identifier; 

register  char  *  opt ional_f orma l_argument_l i st ; 

{ 

print_level (  level  ) ; 
if  (  optioral_type  !=  0  ) 

margin_printf (  "%s  ",  optional_type  ); 

;f  (  optional  f ormal _argument_I i st  :=  C  ) 

ma rgi n_pr int f  (  "FUNCTION  ts(%s)\n",  ider.tr  f  ter,  list( 
opt  i ona  1  _ f ormal_a rgurrer.t_, . st ,  ”,  "  )  ); 

else 

ma rgi n_pr i nt f (  "FUNCTION  %s()\n",  identifier  ); 
i  /*  function  statement  •/ 


FILE:  etimer/statement/imp.  i  ci  t_st  a  temer.t .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Compute  r  Engineering  Re  sear cr.  Laboratory 

*  Author :  Stephen  R.  Wachtel 
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extern  int  level; 
extern  char  *list(  ); 


void  impl icit_statement (  type,  implicit_list  ) 
register  char  "type; 
register  char  *impliclt_list; 

< 

print_level (  level  )  ; 

margin_printf (  "IMPLICIT  %s(%s)\n",  type,  list (  implicit_iist,  ",  ”  )  ); 

)  /*  implicit_statement  */ 


FILE:  etimer/statement/include  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 


void  include_statement (  filename  ) 
register  char  "filename; 

( 

print_level (  level  ) ; 

margin_printf (  "INCLUDE  %s\n",  filename  ); 
)  /»  include_statement  */ 


FILE:  etimer/statement/inquire_statement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 


void  inquire_statement (  control_list  ) 
register  char  *cont rol_l i st ; 

i 

print_level (  level  ) ; 

margin_printf (  "INQUIRE  (%s!  \n",  list(  cont rol_l i st ,  ",  "  )  ); 

)  /*  inqui re_statement  */ 


FILE:  etimer 'statement/intrinsic  statement. c 


/* 

’  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Researcn  Laboratory 

*  Autnor:  Stephen  R.  Wachtel 

'/ 


extern  int  level; 
extern  char  *list(  ); 


void  intrinsic_statement (  i nt r i nsi c_l i s t  ) 
register  char  ' i nt r insi c_i l s t ; 

{ 

print  level!  level  ); 

ma  rgi  n_pr  i  nt  f  (  "INTRINSIC  %s\n",  list!  i  r.t  r  :  n  s  i  r_i  i  st ,  ",  "  )  ); 

!  /*  intrinsic  statement  */ 
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FILE :  at imer/ statement /logical_if_statement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
static  int  save  level; 


void  logical  i f_statement (  ) 

< 

level  =  save_level; 
save_level  =  0; 

)  /*  logical_if_statement  ’/ 


void  i f_expression (  expression  ) 
register  char  'expression; 

( 

print_level (  level  ) ; 

margin_printf (  "IF  < % s )  ",  expression  ); 

save_level  =  level; 
level  =  0; 

}  /’  i f_expression  */ 


FILE:  etimer/statement/namelist  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  'list!  ); 


void  namelist_statement  (  namel i st_name ,  namel i st_i i st  ) 
register  char  'namel i st_name; 
register  char  * namel i st_l i st ; 

i 

print_level (  level  )  ; 

margin_printf (  "NAMELIST  /%s/  %s\n",  namel i st_name,  list!  namel i st_l i st ,  ",  "  )  ); 
)  /'  namelist  statement  */ 


FILE:  et  imer/ statement /ope  restatement .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Ajtr.gr:  Stepner.  R.  Wachtel 


extern  int  level; 
extern  char  'list!  ); 


void  open_statenent (  control_Jist  ) 
register  char  *cont rol_l  i  st  ; 

f 

print_level<  level  )  ; 

margin_printf (  "OPEN  !%s)\n",  list!  cont ro l_i i st ,  ",  "  )  ); 
1  /'  open_statement  */ 


etimer / statement /pa  rame ter 


statement .  c 
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/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  level; 
extern  char  ‘parse (  ); 


void  parameter_statement (  parameter_list  ) 
register  char  *parameter_list; 

i 

register  char  ‘parameter; 
register  char  ‘identifier; 
register  char  ‘expression; 

print_level (  level  ) ; 
margin_printf (  "PARAMETER  ("  ); 

while  (  parameter  =  parse (  parameter_list  )  ) 

( 

identifier  =  parse (  parameter  ); 
expression  =  parse (  parameter  ); 

margi r,_print f  (  "ts  =  %s",  identifier,  expression  ); 

if  (  strlen(  parameter_list  )  1=  0  ) 

margin_printf (  ",  "  ); 

| 

margin_printf (  ")\n"  ); 

:  /*  parameter_statement  */ 


FILE:  etimer/statement/p'ause_statement .  c 


/‘ 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
’  Author;  Stephen  R.  Wachtel 

*/ 


extern  int  level; 


void  pause_statement (  optional_expression  ) 
register  char  *optional_expression; 

if  (  opt i onal_expression  !=  C  ) 

print_levei (  level  ) ; 

ma rgi n_pr i nt f (  "PAUSE  %s\n",  optionai_expression  ); 

else 

print_level(  level  ); 
marg»r._print f  (  "PA’JSElr."  ); 

■  /*  pause_statement  * / 


FILE:  et ime  r / statement /pr int_st  a t ement . c 


*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 


extern 


t  level; 
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extern  char  *list(  ); 


void  print_statement (  control_list,  optional_io_list  ) 
register  char  *control_list; 
register  char  *optional_io_list; 

( 

if  (  optional_io_list  ! =  0  ) 

{ 

print_level (  level  ) ; 

margin_printf (  "PRINT  (%s)  %s\n",  list(  control_list,  ", 
optional_io_list,  ",  "  )  ); 

} 

else 

1 

print_level (  level  )  ; 

margin_prinf f (  "PRINT  (%s)\n“,  list!  control_list,  ",  °  ) 

) 

}  /*  print_statement  */ 


FILE:  etimer/statement/program_statement .c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
’  Author:  Stephen  R.  Wachtel 

»/ 


extern  int  level; 


void  program_statement (  identifier  ) 
register  char  "identifier; 

( 

print_level (  level  )  ; 

margin_print f (  "PROGRAM  %s\n",  identifier  ); 
(  /*  program_statement  */ 


FILE:  etimer/statement/read  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  "list!  ); 


void  read_statement (  cont rol_l i st ,  opt i ona l_i o_l i st  ) 
register  char  "cont rol_l i st ; 
register  char  "opt ional_io_] i st ; 

( 

if  (  optional_ia_list  !=  0  ) 

i 

pr i nt_ 1 evel (  level  ); 

margir._prir.ti  (  "READ  ( % s )  %s\n",  .:st(  cent rcl_i i st ,  ", 

opt i ona i _i o_i i st ,  ",  "  )  ); 

) 

else 

print._ievel  (  level  ); 

margi n_pr int f (  "READ  (%s)\n",  Iist(  cont rol_l i st ,  ",  "  I 

} 

)  /*  read  statement  */ 


eti me r/statement/ return  statement .c 


"  ),  list ( 


)  ; 


1  ,  list! 


)  ; 


Copyright  1991 
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*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 


void  return_statement (  expression  ) 
register  char  "expression; 

( 

if  (  expression  !-  0  ) 

{ 

print_level (  level  ) ; 
margin_printf (  "RETURN  %s\n”, 

) 

else 


{ 

print_level(  level  ); 
margin_printf (  "RETURNNn"  ); 

) 

t  /*  return  statement  */ 


expression  ) ; 


FILE:  etimer/statemer.t/reuina  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

'/ 


extern  int  level; 
extern  char  *list(  ); 


void  rewind_statement (  control_list  ) 
register  char  *control_list; 

f 

print_level (  level  ); 

margi n_pr i nt f (  "REWIND  (%s)\n“,  list!  control 
)  /»  rewind  statement  */ 


FILE:  et ime r / st atement / save  statement. o 


/  * 

*  Copyrignt  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 


extern  int  level; 
extern,  char  *list(  )  ; 


void  save  statement!  savelist  i 
register  cn.ar  'save  list; 

prinl_level(  ieve.  ); 

ma  rg:  n_pr  i  nt  f  (  "SAVE  %s’n",  ..s’,  !  save  list, 
*  save  statement  */ 


F I .1 :  et .me r / st atement / st op  statement. c 


list,  ",  ”  )  ); 
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extern  int  level; 


void  stop_statement (  optional_expression  ) 
register  char  *optional_expression; 

( 

if  (  optional_expression  !=  0  ) 
f 

print_level (  level  ) ; 

margin_printf (  "STOP  %s\n",  optional_expression  ) ; 

I 

else 

( 

print_level (  level  ) ; 
margin_printf (  "STOPXn"  ); 
i 

}  /*  stop_statement  */ 


FILE:  etimer/statement/subroutine  statement. c 


/’ 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
’  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  ’listf  )J 


void  subroutine_statement (  identifier,  optional_formal_argument_list  ) 
register  char  ’identifier; 

register  char  ’opt ional_f ormal_argument_l i st ; 

( 

if  (  optional_formal_argument_list  !»  0  ) 

< 

print_level(  level  ); 

margin_print f (  "SUBROUTINE  %s(%s)\n“,  identifier,  list! 
opt ional_f ormal_argument_li st ,  ",  "  )  ); 

) 

else 

{ 

print_level (  level  ) ; 

margin_printf (  "SUBROUTINE  %s()\n",  identifier  ); 

) 

)  /*  subroutine  statement  */ 


FILE :  etimer/ statement /uncondit ional_go_to_statement .  c 


/’ 

*  Copyright  1991 

’  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
’  Author:  Stephen  R.  Wachtel 

’  / 


level; 


void  uncond i t i ona l_go_t o_st atement (  label  ) 
register  char  ’label; 

print_level(  level  ); 

margin  printf (  "GO  TO  %s\n",  label  ); 

■  /'  unconditionaI_go_to_statement  ’/ 


FILE:  e t i met / statement /wr i te  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 
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*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  int  level; 
extern  char  *list(  ); 


void  write_statement (  control_l i st ,  opt ional_io_l i st  ) 
register  char  *cont rol_l i st ; 
register  char  *optional_io_list; 

I 

if  (  optional_io_list  !=  0  ) 

< 

print_level (  level  ) ; 

margin_print  f  (  "WRITE  <  %  s )  %s\n",  list(  cont  rol_li  st ,  ",  "  ),  listt 
optional  io_list,  ",  "  )  ) ; 

) 

else 

{ 

print_level (  level  ) ; 
margin_printf (  "WRITE 

) 

}  / *  write  statement  */ 


(%s)\n“,  list!  control_list 


)  )  ; 
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14.  Appendix  I:  initial  program  source 

FILE:  initial/Makefile 


* 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


default:  initial 


CC  =  cc  -g 
INCLUDE  =  include 
CFLAGS  =  -1$ (INCLUDE) 
LIBRARY  =  iibrary/1 ibrary . a 


OBJECTS  =  \ 

$  (INCLUDE) /grammar. h  \ 
•grammar. [co]  \ 

*  scanner .  [co]  \ 
yy t  race .  [ co ]  \ 

y . output 


PROGRAMS  =  \ 
•initial 


grammar. c:  grammar. y 
yacc  -dv  grammar. y 
mv  y.tab.h  S ( INCLUDE) /grammar . h 
mv  y.tab.c  grammar.c 


scanner. c:  scanner. 1 

lex  -vt  scanner. 1  I  sed  ' s/getc/yygetc/ '  >scanner 


scanner. o:  scanner. c  S  (INCLUDE) /grammar  .  h. 

5 (CC)  S (CFLAGS)  -c  scanner. c 

grammar. o:  grammar.c 

S (CC)  S (CFLAGS)  -c  grammar.c 

initial:  grammar. o  scanner. o  S(LIBRARY) 

S (CC)  -o  initial  grammar. o  scanner. o  $(LIBRARY) 


sgramma r . c : grammar . c  yytoken.awk 

awk  -f  yytoken.awk  <grammar.c  >sgrammar.c 

sgramma r.o:  sgrammar.c 

S (CC)  S (CFLAGS)  -c  sgrammar.c 

sinitial:  sgrammar.o  S(LIBRARY) 

S (CC)  -o  sinitial  sgrammar.o  S(LIBRARY) 


ascanner . c :  scanner. c 

cp  scanner. c  dscanner.c 

dscanner.o: dscanner.c  $ (INCLUDE) /grammar . h 
S (CC)  S (CFLAGS)  -DDEBUG  -c  dscanner.c 

dinitial:  grammar,  o  dscar.ner.o  S  (LIBRARY) 

S (CC)  -o  dinitial  grammar.o  dscanner.o  $(LIBRARY) 


t g  ramma r . c : gramma  r . c 

sed  ' s/yy stack : /4  yy t race (yy si  at e ) ; / '  <g 


'.grammar,  o:  tgrammar.c 

$  (CC)  S  (CFLAGS)  -r  r.gramma^.^ 


c 


>tgrammar  .  c 
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tinitial:  tgrammar.o  scanner. o  yytrace.o  $ (LIBRARY) 

S ( CC )  -o  tinitial  tgrammar.o  scanner. o  yytrace.o  $ (LIBRARY) 


yytrace.c:  grammar. c  yytrace.awk 

awi  -f  yytrace.awk  <y. output  >yytrace.c 

yytrace.o:  yytrace.c 

$  (CC)  S(CFLAGS)  -c  yytrace.c 


clean : 

cd  library;  make  clean 
rm  -f  $ (PROGRAMS)  $ (OBJECTS) 


FILE:  initial /grammar . y 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


/* 

*  FORTRAN  77 

*/ 


ttoken  RW_AND 
%token  RW_ASSIGN 
%token  RW_BACK SPACE 
%token  RW_BLOCK_DATA 
ttoken  RW_CALL 
% token  RW_CHARACTEP 
%token  RW_CLOSE 
%token  RW_COMMON 
%token  RW_COMPLEX 
%token  RW_CONTINUE 
%token  RW_DATA 
%token  RW_DIMENSION 
ttokea  RW_DO 

%token  RW_DOUBLE_PRECISION 

%token  RW_ELSE 

%token  RW_ELSE_IF 

%token  RW_END 

%token  RW_END_IF 

%token  RW_ENDFILE 

%token  RW_ENTRY 

ttoken  RW_EQ 

ttoken  RW_EQU I VALENCE 

%token  RW_EQV 

%token  RW_EXTERNAL 

%token  RW_FALSE 

ttoken  RW_FORMAT 

%token  RW_FUNCTION 

%token  RW_GE 

% token  RW_GO_TO 

ttoken  RW_GT 

%token  RW_IF 

ttoken  RW_IMPLICIT 

ttosen  RW_INCLCDE 

ttoker.  RW_1NQUIRE 

ttoken  RW_INTEG£P 

ttoken  RW_INTRINSIC 

ttoken  RW  LE 

ttoken  R»rLOGICAL 

ttoken  RW_LT 

ttoken  RW_NAMELIST 

ttoken  RW_NE 

ttoken  RW_NEQV 

ttoken  RW_N'OT 

ttoken  RW_OPEN 

ttoken  RW_OR 

ttoken  RW  PARAMETER 

ttoken  RW~ PAUSE 

4‘  n'lror  SW  PRINT 

er.  RW  PROGRAM 
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ttoken  RW_READ 
ttoken  RW_REAL 
ttoken  RW_RETURN 
ttoken  RW_REWIND 
%token  RW_SAVE 
ttoken  RW_STOP 
%token  RW_SUBROUTINE 
%token  RW_THEN 
%token  RW_TO 
ttoken  RW_TRUE 
%token  RW_WRITE 
ttoken  RW  UNDEFINED 


ttoken  CONCATENATE 
ttoken  COMMENT 
ttoken  DOUBLE_PRECISION 
ttoken  EXPONENTIATE 
ttoken  HOLLERITH 
ttoken  IDENTIFIER 
ttoken  INTEGER 
ttoken  LABEL 
ttoken  REAL 
ttoken  STRING 


tleft  ' , • 
tnonassoc  ' : ' 
tright  '=' 

tleft  RW_EQV  RW_NEOV 
tleft  RW_OR 
tleft  RW_AND 
tleft  RW_NOT 

tnonassoc  RW_EQ  RW_NE  RW_LT  RW_LE  RW_GT  RW_GE 

'left  CONCATENATE 

tleft  '+• 

tleft  ’/' 

tright  EXPONENTIATE 

tleft  SIGN 


ti 

typedef  char  ‘POINTER; 
♦define  YYSTYPE  POINTER 

♦include  "usage. h" 
static  int  usage  =  REF; 
static  int  level  =  0; 

int  conditional  =  0; 
int  argument_number  *  0; 

tl 


program: 


optional_statement_list 

t 

summary (  )  ; 

) 


opt ; or. a __s t a tement_. i  st : 
/*  NULL  •/ 

statement  list 


statement_list : 

statement 


statement  lost  statement 


statement : 

comment  statement 
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.Labe*  ur. labeled  statement 


comment_stacement : 
COMMENT 


label : 

LABEL 


unlabeled_statement : 

include_statement 

I 

program_statement 

I 

block  data_statement 

I 

funct ion_statement 

I 

sub rout i ne_statement 

I 

ent ry_statement 

1 

end_st  atemer*' 

I 

sped  f icat ion_st element 

I 

{  add_statement_li st (  0,  (  level  '=  C  ?  conditional  :  C  );  ) 

executable_statement 

I 

format  statement 


include_statement : 

RW  INCLUDE  character  constant 


program_statement : 

RW_PROGRAM  program_ident :  f i er 


program_identi f ier : 

IDENTIFIER 

( 

begin_block(  SI  ) ; 

) 


bl ock_data_statement : 

RW  BLOCK  DATA  block  data  identifier 


block _data_identifier: 
IDENTIFIER 

oegi r._biocx  (  SI  ); 


funct ion_statement : 

RW_FUNCTION  function  identifier  opt  ion a l_f orma 1 _a rgumert  list 

[ 

type  RW  FUNCTION  f unct i on_ i dent i f i er  opt ional _ f orma 1 _ a rgument _ 1 i st 


function  identifier: 
IDENTIFIER 

I 

begi n  block!  Si  ) ; 
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I 


subroutine_statement : 

RW_SUBROUTINE  sub r ou t ine_i dent i f ie r 
I 

RW_SUBROUTINE  subrout ine_iaenti f ier  opt i onal_f ormal_argument_l i st 


subrout ine_ident i f ier : 
IDENTIFIER 
{ 

begin_block(  $1  ); 

i 


entrv_statement : 

RWENTRY  entry_identifier 

I 

RW_ENTRY  ent ry_ident i f ier  optional_formal_argument_list 


ent  ry_ident i f ier : 

IDENTIFIER 


opt i on a  I  f ormai_argument_l ist : 

i 

'('  £ormai_argument_l i st  ')' 


f orma l_a  rgument_l i  st : 

formal_argument 

I 

Iormai_argument_list  ’ f ormal_argument 


formal_argument : 

IDENTIFIER 

{ 

add_f ormai_argument_l i st (  SI  ); 

} 

formal_argument_al  te  mat  e_re  turn 

( 

add_f  ormal_argumer,t_list  (  $1  )  ; 


forma l_argument_al ternate_returr : 


$$  =  " “ ; 

) 


end_statement : 

HW_END 

f 

end  block!  ) ; 


spec! f 1  cat  i on_st a  tement : 

external  statement 

;ntrinsic_ statement 

'■  addstatement  list!  0,  0  )  ;  i  parameter  statement 
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dimension_st atement 
dec la rat ion_statement 
save_st atement 
common_st atement 
equivalence_st atement 
implicit_st atement 

(  add_statement_list (  0,  0  );  }  data_statement 

namelist  statement 


external  statement: 

RW  EXTERNA!.  external  list 


external_li st : 

external 

I 

external  list  external 


external : 

IDENTIFIER 


i nt r. i ns ic_st atement : 

RW  INTRINSIC  intrinsic_list 


intrinsic_l i rt : 

intrinsic 

I 

intrinsic  list  intrinsic 


intrinsic: 

IDENTIFIER 


parameter_statement : 

RW_PARAMETER  '('  parameter_li st  ’)' 


parameter_list: 

parameter 

pa rameter_l i st  parameter 


va ramet  e  r : 

pa r arete r_i dent i f ier  expression 


parametcr_identifier: 

IDENTIFIER 

{ 

add  identifier  list!  SI,  0,  SET  ); 


dimension  statement: 

RW  DIMENSION  dimension  list 
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dimension_list : 

dimension 

I 

dimensi on_l i st  dimension 


dimension: 

IDENTIFIER  '  ( ' subscript_list  ')' 


subscript_l i st : 

subscript 

[ 

subscript  list  subscript 


subscript : 

upper_bound 

l 

lower_bound  '  :  '  upper_bound 


lower_bound: 

INTEGER 

1 

’+•  INTEGER 

[ 

INTEGER 

i 

IDENTIFIER 
' +•  IDENTIFIER 

! 

IDENTIFIER 

I 

INTEGER  IDENTIFIER 

IDENTIFIER  INTEGER 


uppe rebound: 

iower_bound 

I 

upper_bound_ad just able 


upper_bound_ad jus table : 


declaration  statement: 

type  declarat ion_i i st 
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type^name : 

RW_CHARACTER 

RW_COMP  LEX 

RW_D0U8LE_PRECISI0N 

i 

RW_INTEGER 

I 

RW_LOGICAL 

I 

RW_REAL 

I 

RM  UNDEFINED 


optional  type_length: 
/"*  NULL  */ 

I 

type_iength 


type^iength : 

' * '  INTEGER 

'*'  type_length_ad justable 


type  iength_ad justable : 

'  (  •  '  *  '  * )  ' 


save_statement: 

R*  sAVE  opt ional_save_l i st 


optional  save_list: 

/"*  NULL  */ 

I 

save  list 


save_l i st : 

save 

savel i st  ' , '  save 


save : 

IDENTIFIER 


common  name 


common  statement: 

”  RW_COMMON  opt  ior.al_  commoner:  a  me  ccrmcr.^var  iacl  e_l  i  st 


octio.nai  common_name : 
/*  NULL  *i 


common  name 


common  name: 

*/'  opt  ion«»l  _iaenn  t  jl«i 


i  dent i f i er : 
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/*  NULL  */ 
IDENTIFIER 


commcr._var  i  abie_l  i  st : 

common  variable 


common  variable  list 


common  variable 


variable : 

IDENTIFIER 

IDENTIFIER  '(’  subscript  list  1  )  * 


equivalence  statement: 

RW_EC’J  I  VALENCE  equi  valence__l  i  st 


equ i va 1 ence_l is: : 

equ i  va  I  en.ce 


equ  i  va  I  er.ce_l :  st 


equivalence 


equ : va .ence: 

’  ( '  equ:valence_ var iable_l is:  ')' 


equi va 1 ence_var i abie_ 1 ist : 

equ 1 va lence_var i able 


equ i va lence_va  r lab le_ list 


equiva  1  er.ce^var  iable 


equivalence  variable: 

IDENTIFIER 

IDENTIFIER  *<*  sucscr i pt _1 i st  •>* 


state 

*W  IMP! 


type  ' < ' 


r  a  -e  I  . s  t  s  t  a  t erne  n t : 

RW  NAMELIST  namelist  ram*'  s* 


n  a 
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namel i  st 

name! i st_l i st  namelist 

name  1 i st : 

IDENTIFIER 

dat a_st atement : 

RW  DATA  data_list 

dat  a_ 1 i st : 

aata 

data  list  optional  comma  data 

data: 

data_variabie_l  1st  ‘  /  '  data_ccnst ar.t_l  i  st  '/* 

data  variable_list: 

data _ variable 

data  variable  list  data_var:aole 

d a  t a  variable: 

variable 

aca_: dent : f i e :_1 i st (  $1,  REF,  SET  ); 

-data  i rp  1 i e d _c o_l  i  s t 

data  implied  ac_ list: 

aat a _var : able_* i st  ' , '  oat a_: cent i f : er  ' = '  express! on_i i s 

data  identifier: 

IDENTIFIER 

add_identifier_i:5t (  $1,  0,  SET  ); 

o  a  t  a  c  o  r.  s  t  a  n  t  _  1 ;  s  t : 

d  a  t  a  _  c  c  n start 

cata  constant  1  *  s  t  ' ,  '  data  constant 


alizatior. 

_ f a c t o r  d a t a _ initialization 

.or.  factor: 

IDENTIFIER 
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data_initialization : 

IDENTIFIER 

i 

add_identifier_list (  SI, 

) 

I 

character_constant 

I 

logical_constant 
'  I 

signed_numer: cal_constant 


signed_numerical_constant : 

numerical_constant 

I 

'+'  numerical_constant  %prec 

I 

numerical_constant  %prec 


expression: 

pa rent he si s_expression 

( 

$$  =  SI; 

1 

i 

simple_expression 

( 

S$  =  SI; 

) 


parenthesis_expression: 

' ( 1  expression  ' ) ' 

( 

$S  = 

) 


simpie_expression : 
variable 
( 

SS  =  SI; 

) 

I 

constant 

f 

SS  =  SI; 

) 

I 

arithmetic_expression 

( 

SS  =  SI; 

) 

I 

character_expression 

( 

SS  =  SI; 

t 

reiational_expression 

f 

SS  =  SI; 

) 

I 

logical_exp cession 

( 

SS  =  Si; 


una  ry_expressi on 

; 

SS  =  '  1; 


0,  REF  ) ; 


SIGN 

SIGN 
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variable : 

identifier 

< 

$$  =  SI; 

1 

I 

identifier  string_subset 
f 

$$  =  $1; 


array 

( 

SS  -  SI; 

) 


array: 

identifier  '('  optional_expression_list  ')' 

{ 

SS  =  SI; 

> 

I 

identifier  ' ('  optional_expression_iist  string_subset 

( 

SS  =  SI; 

( 


identifier: 

IDENTIFIER 

I 

add_identifier_list (  SI,  0,  usage  ); 
if  (  usage  ==  SET  )  usage  »  REF; 

SS  =  SI; 


optional  expression_li st : 
r*  NULL  */ 

I 

expression__list 


expression_list : 

expression 


express! on_l i st 


expression 


st ring_subset : 

'(’  opt ional_expression  opt ionai_expressi on  ')’ 


optional  expression: 
r*  NULL  */ 

express  i  or. 


constant : 


cha  ract e  r_const ant 
{ 

$$  =  $1; 

} 


logical  constant 
$$  *  $1; 

numerical  constant 
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{ 

SS 


) 


Si; 


logical_constant : 
RW_FALSE 
f 

SS  - 

1 

I 

RW_TRUE 

{ 

SS  = 

) 


character_constant : 
HOLLERITH 
i 

SS  = 

) 

I 

STRING 

( 

SS  = 

) 


numerical_constant : 

DOUBLE_PRECISION 

( 

SS  = 

) 

I 

INTEGER 

( 

SS  = 

) 

I 

REAL 

{ 

SS  = 

) 


arithmetic_expression; 

expression  •+*  expression  %prec  '+' 

{ 

SS  = 

) 

I 

expression  expression  %prec 

{ 

SS  =  " " ; 

) 

I 

expression  '**  expression  %prec 

( 

S$  =  ••••; 


expression  '/'  expression  %prec  '/' 

( 

SS  - 
I 


expression  EXPONENTIATE  expression  %prec  EXPONENTIATE 
( 

SS  - 

) 


=haracter_expressi 

expression 


on : 

•  /  ' 


' / '  expression 


%prec  CONCATENATE 
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$$  = 


relat ional_expression: 

expression  RW_EQ  expression  %prec  RW_EQ 

f 

S$  = 

) 

I 

expression  RW_N£  expressio-  Iprec  RW_NE 

{ 

$$  =  — ; 

1 

I 

expression  RW_LT  expression  %prec  RW_LT 

{ 

$$  = 

) 

I 

expression  RW_LE  expression  %prec  RW_LE 

( 

S$  = 

1 

I 

expression  RW_GT  expression  %prec  RW_GT 

( 

SS  =  " " ; 

) 

I 

expression  RW_GE  expression  %prec  RW_GE 

( 

SS  =  " “ ; 

) 


logical_expression : 

expression  RW_AND  expression  %prec  RW  AND 
( 

SS  =  " "  ; 

} 

I 

expression  RW_OR  expression  trprec  RW_OR 

( 

SS  =  '•••; 

) 

i 

expression  RH_EQV  expression  %prec  RW_EQV 

( 

SS  =  " " ; 


expression  RW_NEQV  expression  %prec  RW_NEQV 

< 

SS  = 

) 


una  ry_expression : 

expression  %prec  SIGN 

SS  =  " " ; 


expression  %prec  SIGN 
i 

SS  = 

I 

RW_NOT  expression  %prec  RW_NOT 

( 

SS  - 

1 


executabiestatement : 

do  statement 
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logical_i f_statement 

block_i f_statement 

else_statement 

else_i f_statement 

end_i f_statement 

subset  executable  statement 


do_statement : 

RW_DO  INTEGER  do_ident i f ie r  •=•  expression_list 


do_identifier : 

IDENTIFIER 

( 

add_identif ier_list (  $1,  0,  SET  ); 

) 


logical_if_statement : 

i f_expression  subset_executable_statement 

( 

level--; 

1 


if  expression: 

RW_IF  '('  expression  ’)• 

{ 

level ++; 

) 


block_i f_statement : 

RW_IF  '('  expression  ')'  RW_THEN 

( 

level++ ; 

) 


else_statement: 

RW_ELSE 

( 

level--; 
level++ ; 

) 


el se_i f_statement : 

RW_ELSE_IF  '('  expression  •)*  RW_THEN 

( 

level --; 

I  eve  i  -•*  ; 


end_i f_statement : 

RW_END_IF 

I 

level--; 

) 


subset_executable_statement : 

assignment_statement 
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assign_statement 
a  ri thmet ic_i f_statement 
con tinue_st a cement 
cal l_statement 
return_statement 
uncondit ional_go_to_statement 
computed_go_to_statement 
assigned_go_to_statement 
stop_statement 
pause_statement 
io_statement 

assignment_statement : 

{  if  (  usage  ==  REF  )  usage  =  SET;  I  variable  '='  expression 


assign_statement : 

RW  ASSIGN  INTEGER  RW  TO  IDENTIFIER 


arithmetical f_st a cement : 

RW_IF  '('  expression  1 )  *  integer_list 


continue_statement : 

RW_CONTINUE 

statement : 

RW_CALL  call_identifier 

RW_CALL  call_identif ier  optional_actual_argument_list 

call_identifier: 

IDENTIFIER 

add_statement_list (  $1,  0  ); 

1 


call 
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I 


I 


optional_actual_argument_list : 


•  <■ 

{  usage  &=  ~REF;  } 
actua I _a rgument  li st 
•  usage  ' =  REF;  } 

*  )  ' 


act. uala rgument  1  i  st : 

act ual_a rgument 

actua  l__argument_l  i  st  '  ,  '  actua  i_a  rgument 


actual _ a  rgument : 

{  a  rgument  nurr.be  r  ♦  +  ;  }  expression 

i 

[  argument_number**;  )  actual  argument  alternate  return 
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actual_argument_alternate_return : 
•  * '  INTEGER 
( 

$$  = 

1 


return_statement : 

RW_RETURN  optional_expression 


unconditional_go_to_statement : 
RW  GO  TO  INTEGER 


computed_go_to_statement : 

RW_GO_TO  1 ('  integer_list  ') 1  optional 


assigned_go_to_statement : 

RW_GO_TO  IDENTIFIER 

RW_GO_TO  IDENTIFIER  optional_comma  '(' 


integer_l ist : 

INTEGER 

I 

integer_list  INTEGER 


optional  comma: 

/■*  NULL  */ 


pause_statement : 

RW_PAUSE  optional_expression 


st op_statement : 

RW_STOP  opt ional_expression 


i c_statement : 

open_statement 

cl ose_st atement 

i nqui re_st atement 

:ead_ st atement 

wr i te_st atement 

print _st atement 

ackspace_st atement 

rewi nd_st atement 

! 

endf  i le_statement 

cpe restatement : 

RW  OPEN  ’ (’  control  information  list 


comma  expression 


integer_list  ' ) ' 
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close_statement : 

RW  CLOSt.  '('  control  information_list  ' )  1 


inqui re_statement : 

RW  INQUIRE  '('  control_information_list  ')’ 


read_statement : 

~  RW_READ  '('  control_inf ormation_list  ')'  optional_io_list 

I 

RW  READ  control 

RW  READ  control  io_list 


write_statement : 

RW  WRITE  '('  control  inf ormation_list  ')'  optional_io_list 


statement : 

RW_PRINT  control 

RW  PRINT  control  io  list 


backspace_statement : 

RW_BACKSPACE  '('  control_inf orma t i on_l i St  ')' 

I 

RW  BACKSPACE  control 


rewind_statement : 

RW_REWIND  '('  control_information_list  ')' 
I 

RW  REWIND  control 


endf i le_statement : 

RW_ENDFILE  control_information_list  ')' 

I 

RW  ENDFILE  control 


con t r ol_inf orma tion_li st : 

cont rol_in format ion 

control  information_list  control_information 


cont  rol _in format ion : 
cont  rol 

IDENTIFIER  '*•  expression- 


print 


cont  rol : 

vari abl e 

I 

constant 

| 


opt 


/*  NULL  */ 
io  list 
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io_list : 

io 

I 

io_list  1 , '  io 


expression 

io_implied_do_list 


io_imp!ied_do_list : 

'('  io_list  io_identifier  •  =  '  expressionlist  ' ) 1 


io_identifier: 

IDENTIFIER 

! 

add_ident i f ier_l i st (  $1,  0,  SET  ); 

) 


format_statement : 

RW  FORMAT 


%% 


FILE:  initial/include/list. h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


idefine  LIST  struct  list 
LIST 
( 

char  ‘identifier; 
int  line; 
int  usage; 

int  argument_number; 

LIST  *argument_list; 

LIST  ‘next; 

>  ; 

extern  LIST  ~end_list(  ); 

extern  LIST  ‘add_list_forward (  ); 

extern  LIST  ‘add_l i st_reverse (  ); 

extern  LIST  *find_list(  ); 

extern  void  aad_f ormal_argument_l 1 st (  ); 

extern  voia  add_statement_list (  ); 

extern  LIST  *add_list(  ); 

“xtern  void  aad_identi f ier_list (  ); 
extern  void  begi n_bl ock (  ); 
extern  void  end_block(  ); 

extern  void  usage_actual _argument_l i st (  ); 
extern  void  usage_formal_argument_l i st (  ); 
extern  int  f i nd_bl ock_number (  ); 
extern  void  usage_block(  ); 


* define  MAXIMUM_NUMBER_BLOCK  1024 

extern  char  ‘block!  MAXIMUM_NUMBER_3L0CK  ]; 

extern  inf  recursive!  MAXIMUM_NUM3ER_BL0CK  ]  ; 

extern  LIST  *  formal_argument_l  i  st  !  MAXIML'M_N"JM3ER  BLOCK  ]; 

extern  LIST  *  va  r  i  abTe_  1  i  st  [  KAXIMUM_N'JM3ER“BL0CK  }: 
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extern  LIST  * statement_li st [  MAX I MUM_NUMBER_BLOCK  ]; 
extern  int  number_block; 


FILE:  initial/include/usage. h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


•define  REF  0x1 
•  define  SET  0x2 
•define  CONDITIONAL  0x4 
#def ine  INITIALIZED  0x8 


FILE:  initial /library/Makef ile 


• 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


CC  =  cc  -g 
INCLUDE  =  ../include 
CFLAGS  =  -IS (INCLUDE) 
LIBRARY  =  library. a 


OBJECTS  =  \ 

duplicate. o  \ 
hollerith.o  \ 
intrinsic. o  \ 
link_list.o  \ 
main.o  \ 
non_blank.o  \ 
summary. o  \ 
uppercase. o  \ 
yyerror.o  \ 
yygetc.o  \ 
yywrap. o 


S (LIBRARY) : S (OBJECTS) 

ar  crv  S (LIBRARY)  S (OBJECTS) 
ranlib  S (LIBRARY) 


.SUFFIXES:  .c  .o 
.  c  .  o  : 

S (CC)  -c  S (CFLAGS)  S< 


clean : 

rm  -f  S (LIBRARY)  S (OBJECTS) 


FILE:  initial/library/ duplicate. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


•include  <stdio.h> 
•include  <string.h> 
•include  <malloc.h> 
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char  ‘duplicate (  string  ) 
register  char  ‘string; 

f 

register  char  ‘temporary  =  (char  *)NULL; 

if  (  string  !=  (char  *)NULL  ) 

( 

if  (  (  temporary  =  (char  *)malloc(  strlen(  string  )+!))!=  (char 

strcpyl  temporary,  string  ); 

else 

fprintf(  stderr,  "ERROR;  duplicate (  %s  )  \n",  string  ); 

1 


return)  temporary  ); 
)  /*  duplicate  */ 


FILE:  initial /library /hoi lerith.c 


/* 

’  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 


char  ‘hollerithl  string,  delimeter  ) 
register  char  ‘string; 
register  char  delimeter; 

( 

int  hoi leri th_length; 
register  int  string_length  =  0; 

sscanf (  string,  "%dh",  Shollerith_lengch  ); 

string!  string_length++  )  =  delimeter; 

while  (  hollerith_length  !=  0  ) 

( 

if  (  (  string!  string_iength  )  =  yyinput!  )  )  ==  '\n'  ) 

( 

yyunput (  string!  string_length  1  ); 
break; 

1 

string_length+t; 

hollerith_length--; 

) 

string!  string_length++  )  -  delimeter; 

string!  string_length  !  =  '\0’; 

return (  string  )  ; 

)  /*  hollerith  */ 


FILE:  initial/library /intrinsic. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Tecnno»ogy 

’  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  char  ‘duplicate  (  ); 
extern  char  ‘uppercase!  ); 


static  char  * i nt r i ns i c_tabie [ 

" ABS " , 

"ACOS", 

"A  I MAG", 

"AIN'T"  , 


* )  NULL  ) 
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"ALOG", 

"ALOGIO", 

"AMAXO", 

"AMAX1 " , 

’•AMINO", 

"AMIN1 " , 

"AMOD”, 

"ANINT”, 

"ASIN", 

"ATAN”, 

"ATAN2", 

"CABS", 

"CCOS", 

"CEXP", 

"CHAR", 

"CLOG", 

"CMP LX”, 

"CON JG" , 

"COS", 

"COSH", 

"CSIN", 

"CSQRT" , 

"DABS”, 

"DACOS", 

"DAS IN”, 

"DATAN", 

"DATAN2 " , 

"DBLE" , 

"DCOS", 

"DCOSH", 

"DDIM" , 

"DEXP", 

"DIM”, 

"DINT", 

"DLOG", 

"DLOGIO", 

"DMAX1 " , 

" DMIN1 " , 

"DMOD", 

"DNINT", 

"DPROD" , 

"DSIGN", 

"DSIN", 

"DSINH" , 

"DSQRT", 

"DTAN" , 

"DTANH" , 

"EXP", 

"FLOAT", 

"TABS", 

"I CHAR", 

"IDIM", 

"IDINT", 

"IDNINT", 

"IFIX", 

"INDEX", 

"INT", 

"I  SIGN" , 
"LEN", 
”LGE“, 
"LGT", 

” LLE” , 


"LOG”, 

"LOGIO" 

"MAX", 

"MAXO", 

"MAXI", 

"MIN", 

"MINO", 

"MINI", 

"MOD", 

"NINT”, 

"REAL", 

"SIGN", 

"SIN", 

"SINH", 

"SNGL” , 

"SORT" , 

"TAN", 

"TANH" 
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} ; 


^define  INTRIN3IC_TABLE  {  sizeof  (  intrinsic  table  )  /  sizeof(  char  *  )  ) 


int  intrinsic(  identifier  ) 
register  char  "identifier; 

{ 

register  int  low,  high; 
register  int  middle,  test; 

register  char  "temporary  =  dupiica*e{  identifier  ); 

I ow  =  0 ; 

high  =  I NTR I NS I CITABLE  -  1; 

uppercase (  temporary  ); 

while  (  low  <*  high  ) 

{ 

middle  =  {  low  +  high  )  /  2; 

test  =  strcmp(  temporary,  ir.tr:nsic_tabie (  middle  J  ); 

if  {  test  <  0  ) 

{ 

high  =  middle  -  1; 
cont inue; 

) 

i  f  {  test  >  0  ) 

low  =  middle  -  1; 
cont i nue; 

} 

f  ree  {  temporary  ); 
return  <  1  ) ; 


f ree {  temporary  ); 
return {  0  ) ; 

/  *  intrinsic  *  / 


t  I  LE :  initial/library/link_list.c 


*  Copy r i ght  1 991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 


kind  ude 

<  st d  i  o  . 

h> 

f.r.cl  ude 

<ma 1 1 oc 

.  h  > 

*  >r.  ci  uae 

< st  r i ng 

.  h> 

# i rci ude 

"list  .  h 

" 

*  i  n.c  1  ude 

"usage. 

extern  i  n 

-  yy^in 

eno 

i  r.t  araumer.t 


i  r  -o.ock.  MAXIMUM  NUMBER  block  ; , 
t  recursive;  VAX  1  MUM  NUMBER  BLOCK 
ST  *  forma  ;  a  rgumer.t_  1  i  s  t  ;  MAXIMUM  NUMBERBLCCK 
5T  "variable  list;  MAX  I  MUM  NUMBER  "'BLOCK  1  ; 

ST  *statement_i ;st ;  MAXIMUM  NUMBER  BLOCK 
t  number  block  =  0; 


•de.ine  FORWARD  C 
•define  REVERSE  1 
s t  a  t  .  c  id  c  roe  r  -  FORWARD ; 


st ; 
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if  (  list  ! =  (LIST  * ) NULL  ) 

t 

while  (  list->next  !=  (LIST  *)NULL  ) 
list  »  list->next; 

1 


return (  list  ) ; 
i  /*  end  list  */ 


LIST  *add_l i st_f orward (  list,  identifier  ) 
register  LIST  "list; 
register  char  ‘identifier; 

register  LIST  ‘temporary  =  (LIST  *)rr.alIoc<  sizeofl  LIST  )  )  ; 

temporary->identif ier  =  identifier; 
temporary"!  ine  -  yylineno; 
temporary->usage  *  0; 

temporary->argument_number  =  argument_number; 
temporary->argument_list  =  (LIST  *)NULL; 
temporary->next  =  (LIST  *)NULL; 

if  (  ‘list  ==  (LIST  * ) NULL  ) 

‘list  »  temporary; 

else 

end_list(  ‘list  )->next  =  'emporary; 

return)  temporary  ); 

•  /'  add  list  forward  */ 


LIST  *add_l i st_reverse (  list,  identifier  ) 
register  LIST  “list; 
register  char  ‘identifier; 

( 

register  LIST  ‘temporary  =  (LTST  *)mailoc(  sizeofl  LIST  !  ); 

temporary->identifier  =  identifier; 
tempora ry->l ine  =  yylineno; 
temporary->usage  =  0; 

temporary->argument_number  =  argument_number; 
temporary->argument_l i st  «  (LIST  *)NULL; 
temporary->next  =  ‘list; 

‘list  =  temporary; 

return!  temporary  ); 

!  /*  add  list  reverse  */ 


LIST  *find_list(  list,  identifier  ) 
register  LIST  ‘list; 
register  char  ‘identifier; 

register  LIST  ‘temporary  =  (LIST  *)NULL; 

while  (  list  !=  (LIST  *)NULL  ) 

if  (  strcmpl  1  i  st->i  dent  i  f  i  er ,  laeriLiiiet  )  -=  0  ) 

temporary  -  list; 

list  =  list->next; 


return  (  temporary  ); 
*  find  list  *  / 


void  add  forma,  a rgument _1 i st  (  identifier  ) 
register  char  ‘identifier; 

argument  number"; 

add  1 i st_ f orwa rd (  4 f orma i_a rgument_ 1 l st i  number  block  )f  identifier  ); 
*  add  formal  argjnert  i l st  */ 


void  add  statement  list(  identifier,  usage  i 
register  char  ‘identifier; 
r»’o.s*er  mt  usage; 
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{ 

argument_number  =  0; 

if  (  identifier  !=  (char  '(NULL  ) 

( 

end_list (  statement_list [  number_block  1  ) ->ident i f ier  =  identifier; 
order  =  FORWARD; 

) 

else 

{ 

add_list_forward (  Sstatement_list [  number_block  i,  identifier  )->u;aqe 
order  =  REVERSE; 

} 

}  /*  add  statement  list  */ 


LIST  *add_list(  identifier,  block_number  ) 
register  char  'identifier; 
register  int  block_number; 

( 

register  LIST  'temporary; 

temporary  =  find_list (  f ormal_argument_list (  block_number  ],  identifier  ); 
if  (  temporary  !-  (LIST  *)NULL  ) 
return!  temporary  ); 

temporary  =  find_list (  variable_list (  block_number  ],  identifier  ); 
if  (  temporary  !=  (LIST  *)NULL  ) 
return!  temporary  ); 

temporary  =  add_list_forward  (  svariable_lis‘t  [  block_number  1,  identifier  ); 
return  (  temporary  ) ; 

)  /'  add  list  */ 


void  add_identifier_list (  identifier,  and_usage,  or_usage  ) 
register  char  'identifier; 
unsigned  int  and_usage; 
unsigned  int  or_usage; 

{ 

register  LIST  'temporary; 

switch  (  order  ) 

( 

case  FORWARD: 

if  (  and_usage  !=  0  ) 

( 

temporary  =  find_list(  end_list(  statement_list (  number_block  ) 
>argument_list,  identifier  ); 

temporary->usage  S=  ~and_usage; 

) 

else 

temporary  =  add_list_forward (  Send_list(  statement_list [  number 
>argument_list,  identifier  ); 
break; 

case  REVERSE: 

if  (  and_usage  !=  0  ) 

( 

temporary  =  find_list(  end_list(  statement_l i st  [  number_block  ] 
>a rgument_l i st ,  identifier  ); 

temporary->usage  s=  -andjjsage; 

e,  se 

temporary  =  add_l i st_reverse (  &end_list(  statement_iist [  number 
>argument_l i st ,  identifier  ); 
break ; 

) 

temporary->usage  1=  oi_usage; 

1  /*  add  identifier  list  */ 


void  beg; n_block (  identifier  ) 
register  char  'identifier; 

{ 

block [  number_block  ]  =  identifier; 
recursive!  number_block  ]  =  0; 

f  orma  1  _a  rgument_l  i  st  [  number_biock  -  (LIST  *)NULL; 


-  usage; 


)  - 


block  ]  )  - 


)  - 


bl ock  ]  )  - 
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variable_list [  number_block  ]  «  (LIST  *)NULL; 
statement_list [  number_block  ]  =  (LIST  *)NULL; 
argument_number  =  0; 

}  /*  begin_block  */ 


void  end_block (  ) 

I 

number_block++; 
)  /*  end  block  */ 


void  usage_actual_argument_l i st (  block_number,  actual_argument_list,  usage  ) 

register  int  block_number; 

register  LIST  *actual_argument_list; 

register  int  usage; 

( 

register  LIST  'temporary; 

while  (  actual_argument_list  !=  (LIST  *)NULL  > 

( 

temporary  «  add_list (  actual_argument_list->identif ier,  block_number  ); 
temporary->usage  |=  usage; 

switch  (  temporary->usage  ) 

{ 

case  (  0  ) : 

case  (  CONDITIONAL  ) : 

temporary->usage  1=  actual_argument_list->usage; 
if  (  (  usage  t  CONDITIONAL  )  ==  CONDITIONAL  ) 
temporary->usage  s=  -INITIALIZED; 

if  (  (  temporary->usage  £  CONDITIONAL  )  !=  CONDITIONAL  ) 

if  (  (  (  temporary->usage  i  SET  )  ==  SET  )  ti  (  (  temporary->usage  t 

REF  )  !=  REF  )  ) 

temporary->usage  1=  INITIALIZED; 

break; 


case  (  REF  ) : 

case  (  REF  I  INITIALIZED  ) : 

if  (  (  actual_argument_list->usage  l  CONDITIONAL  )  ==  CONDITIONAL  ) 
temporary->usage  1=  CONDITIONAL; 

case  (  REF  I  CONDITIONAL  ) : 

case  (  REF  I  CONDITIONAL  I  INITIALIZED  ) : 

if  (  (  actual_argument_list->usage  &  SET  )  •«  SET  ) 

temporary->usage  |=  SET; 
break; 


case  (  SET  ) : 

case  (  SET  I  INITIALIZED  ) : 

if  (  (  actual_argument_list->usage  &  CONDITIONAL  )  ==  CONDITIONAL  ) 

temporary->usage  1=  CONDITIONAL; 

case  (  SET  I  CONDITIONAL  ) : 

case  (  SET  I  INITIALIZED  I  CONDITIONAL  ) : 

if  (  (  actual_argument_list->usage  i  REF  )  ==  REF  ) 

temporary->usage  1=  REF; 
break; 


case  (  REF  I  SET  ) : 

case  (  REF  I  SET  ;  CONDITIONAL  ): 

case  (  SET  I  REF  I  INITIALIZED  ) : 

case  (  SET  I  REF  I  CONDITIONAL  I  INITIALIZED  ) : 

break; 


actual_argument_list  =  act ua  1  _argument_i i st->next ; 

! 

!  /*  usage_act ua l_a rgument_l i st  */ 


void  usage_f orma l_argument_I i st (  actual_argument_l ist,  formal_argument_l i st  ) 
register  LIST  *actua l_argument_l i st ; 
register  LIST  *  formal _a rgument_l i st ; 

< 

while  (  (  actual_argument_list  !=  (LIST  *)N'JLL  )  ii  (  formal _ argumenl_l i st  !  = 


(LIST 
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* ) NULL  )  ) 

{ 

if  (  actual_argument_list->argument_number  ==  formal_argument_list- 
>argument_number  ) 

) 

actual_argument_list->usage  =  f ormal_argument_list->usage; 
actual_argument_list  =  actual_argument_list->next; 

} 

else 

f ormal_argument_list  =  formal_argument_list->next; 

1 

)  /*  usace_formal_argument_list  */ 


int  f ind_block_number (  identifier  ) 
register  char  'identifier; 

{ 

register  int  block_number; 

for  (  block_number  =  0;  block_number  <  number_block;  block_number++  ) 

{ 

if  (  stremp)  block)  block_number  ),  identifier  )  =-  0  ) 
return)  block_number  ); 

) 

fprintf)  stderr,  "WARNING:  block  %s  not  found\n",  identifier  ); 
begin_block(  identifier  ); 
end_block(  ); 

return)  number_block  -  1  ); 

}  /*  find  block  number  */ 


void  usage_block (  block_number,  actual_argument_l i st  ) 

register  int  block_number; 

register  LIST  *actual_argument_l ist ; 

1 

register  LIST  'statement  =  statement_list [  block_number  ); 

if  (  recursive)  block  number  1  !=  0  ) 

( 

fprintf)  stderr,  "ERROR:  block  %s  recursive\n",  block)  block_number  ]  ); 
exit (  -1  ) ; 

) 

recursive)  block_number  )  =  1; 

while  (  statement  !=  (LIST  ’)NULL  ) 

( 

if  (  statement->identif ier  !=  (char  * ) NULL  ) 

usage_block(  f ind_block_number (  statement-> ident i f ier  ),  statement- 
>argument_list  ); 

usage_actual_argument_list (  bl ock_number,  statement ->a rgument_l i st ,  statement- 
>usage  )  ; 

statement  =  statement->next; 

) 

usage_formal_argument_list (  actual_argument_list,  formal_argument_list [  block_number  1 

); 

recursive)  biock_number  )  *  0; 
i  /*  usage_block  */ 


FILE:  i n i t i a  1 / 1 i brary /mai n . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


((include  <stdio.h> 
((include  <string.h> 
((include  "usage,  h" 


extern  FILE  'yyin; 
extern  FILE  'yyout; 
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extern  int  conditional; 


#define  PROGRLM  argument!  0  ) 
♦define  INPUT_FILE  argument!  1  1 
♦define  OUTPUT_FILE  argument!  2  ) 


int  main!  number_argument,  argument  ) 
int  number_argument; 
char  ‘argument!  ]; 

( 

loop; 

if  (  stremp!  argument!  number_argument  -  1  1,  ”-conditional=y"  )  ==  0  ) 

{ 

number  argument — ; 
conditional  £=  -CONDITIONAL; 
goto  loop; 

) 

if  (  stremp!  argument!  number_argument  -  1  ),  "-conditional=n"  )  ==  0  ) 

< 

number  argument — ; 
conditional  |=  CONDITIONAL; 
goto  loop; 

) 

if  (  number_argument  ==  1  ) 

{ 

yyin  =  stdin; 
yyout  =  stdout; 

yyparse  (  ) ; 
exit (  0  ) ; 

> 


if  (  number_argument  ==  3  ) 

( 

if  (  (  yyin  =  f open (  INPUT_FILE,  ”r"  )  !  ==  (FILE  *)NULL  ) 

{ 

fprintf(  stderr,  "%s:  ERROR  -  unable  to  open  input  file  ' %s'\n",  PROGRAM, 
INPUT_FILE  ) ; 

exit!  -1  ) ; 


) 

if  (  (  yyout  =  f open <  OUTPUT_FILE,  "u"  )  )  ==  (FILE  *)NULL  ) 

! 

fprintf (  stderr,  ”%s:  ERROR  -  unable  to  open  output  file  ’%s'\n",  PROGRAM, 
OUTPUT_FILE  ) ; 

exit  (  -1  ) ; 

> 


yyparse (  ) ; 
exit (  0  ) ; 


fprintf  (  stderr,  “usage:  %s  <input  file>  <output  file>  (-conditional=y  or  n]\n“, 
PROGRAM  )  ; 

exit (  0  )  ; 

)  /*  main  */ 


FILE:  initial /I ibrary /non_bl ank . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <string.h> 


char  *non_blank (  string  ) 
register  char  ‘string; 

1 

register  int  offset; 
register  int  length; 
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length  =  strlen!  string  )  -  1; 
while  (  (  string!  length  )  == 
string!  length —  ]  =  '\0'; 

offset  =  0; 

while  (  (  string!  offset  ]  == 
string!  offset++  ]  =  '\0'; 


)  44  (  string!  length  ) 


)  44  (  string!  offset  ) 


strcpy!  string,  Sstring!  offset  1  ); 


if  (  strlen!  string  )  !=  0  ) 

return!  string  ); 

else 

return (  0  ) ; 

}  /*  non_blank  */ 


■\0'  )  ) 


•\0'  )  ) 


FILE:  initial/library/summary . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 
((include  <string.h> 
((include  "list.h" 
((include  "usage. h” 


extern  FILE  *yyin; 
extern  FILE  ‘yyout; 


void  print_list(  file,  string,  list  ) 
register  FILE  "file; 
register  char  ‘string; 
register  LIST  ‘list; 

{ 

int  column  =  strlen!  string  ); 
char  buffer!  256  ); 

fprintf!  file,  "%s",  string  ); 

while  (  list  ! =  (LIST  ‘(NULL  ) 

( 

fprintf!  file,  "%s”,  list->identi f ier  ); 
column  +«  strlen!  list->identif ier  ); 

if  (  list->usage  !=  0  ) 

( 

fprintf (  file,  " ( "  )  ; 
column++ ; 

if  (  (  list->usage  i  CONDITIONAL  )  ==  CONDITIONAL  ) 

! 

fprintf (  file,  "C"  )  ; 
column++  ; 


if  (  ( 
{ 

if 

( 


) 

i  f 
< 


) 

else 

f 


Iist->usage  &  INITIALIZED  )  ==  INITIALIZED  ) 

(  (  list->usage  4  SET  )  ==  SET  ) 

fprintf (  file,  "S"  )  ; 
col umn++ ; 


(  (  list->usage  4  REF  )  -=  REF  ) 

fprintf (  file,  "R"  )  ; 
column  +  + ; 
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if  (  (  list->usage  &  REF  )  REF  ) 

( 

f print f (  file,  “R"  >; 
column++; 

} 

if  (  (  list->usage  t  SET  )  ==  SET  ) 

{ 

fprintf (  file,  "S"  ); 
column++; 

} 

} 

fprintf (  file,  ")"  )  ; 
column++ ; 

) 

if  (  list->argument_number  !=  0  ) 

{ 

sprintf (  buffer,  ”=%d“,  list->argument_number  ); 
fprintf (  file,  "%s",  buffer  ); 
column  +=  strlen!  buffer  ) ; 

} 

if  (  list->next  !  =  (LIST  *)NULL  ) 

fprintf!  file,  ) ; 

co} umn++; 

♦define  MAXIMUM  COLUMN  72 

if  (  column  >=  MAXIMUM_COLUMN  ) 

fprintf(  file,  "in"  ); 
fprintf!  file,  M\t\t"  ); 
column  =  8; 

} 

) 

list  =  list->next; 

1 

)  /*  print_list  */ 


void  print_statement_list (  file,  list  ) 
register  FILE  'file; 
register  LIST  ‘list; 

1 

register  char  string!  256  ); 

while  (  list  !=  (LIST  *)NULL  ) 

{ 

if  (  list->identifier  !=  (char  *)NULL  ) 

{ 

if  (  (  list->usage  t  CONDITIONAL  )  -=  CONDITIONAL  ) 

sprintf!  string,  “  line  %djC),  %s(”,  list->line,  1 i st->identi f ier  ) 

else 

sprintf!  string,  line  %d,  %s(”,  list->line,  list->identif  ier  )  ; 

print_list(  file,  string,  list->argument_list  ) ; 
fprintf!  file,  ")\n"  ) ; 

) 

el  se 

f 

if  (  list->argument_list  !=  (LIST  *)NULL  ) 

if  (  (  list->usage  &  CONDITIONAL  )  =-  CONDITIONAL  ) 

sprintf!  string,  "  line  %a\Cj,  ”,  list->iine  ) ; 

else 

sprintf!  string,  "  line  %d,  ",  list->Iine  ) ; 
print  list!  file,  string,  1 i st->argument_l i st  >; 
fprintf!  file,  ”\n"  ); 

! 

} 

list  =  list->next; 

) 

i  /*  print_statement_list  */ 


void  print  variable_list (  file,  biock_number  ) 
register  FILE  'file; 
register  ir.t  bl ock_number ; 
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( 

register  LIST  'variable  =  variable_list [  block  number  ); 

while  (  variable  !=  (LIST  *)NULL  ) 

{ 

Kifdef  DEBUG 

fprintf(  file,  “%s  ",  variable->identif ier  ); 

if  (  (  variable->usage  i  CONDITIONAL  )  ==  CONDITIONAL  ) 
fprintf(  file,  ”C"  ); 

else 

fprintf (  file,  ) ; 

if  (  (  variable->usage  &  INITIALIZED  )  ==  INITIALIZED  ) 

( 

if  (  (  variable->usage  i  SET  )  ==  SET  ) 
fprintf (  file,  "S"  ); 

else 

fprintf!  file,  ); 

if  (  (  variable->usage  t  REE  )  ==  REF  ) 

fprintf!  file,  "R"  ); 

else 

fprintf!  file,  ); 

) 

else 

( 

if  (  (  variable->usage  t  REF  )  ==  REF  ) 

fprintf!  file,  "R"  ); 

else 

fprintf (  file,  ) ; 

if  (  (  variable->usage  &  SET  )  ==  SET  ) 
fprintf!  file,  "S"  ); 

else 

fprintf!  file,  ); 

) 

fprintf!  file,  "\n"  ); 

kelse 

if  (  (  variable->usage  &  INITIALIZED  )  !=  INITIALIZED  ) 

f 

if  (  (  variable->usage  s,  REF  )  ==  REF  ) 

{ 

if  (  (  variable->usage  s  SET  )  ==  SET  ) 

fprintf!  file,  "%s  RS\n",  variable->identi f ier  ) ; 

else 

fprintf!  file,  "%s  R-\n",  variable->identi f ier  ); 

} 

) 

#endi f 

variable  =  variable->next ; 

) 

)  /*  print_variable  list  */ 


void  summary!  ) 

i 

register  int  block_number; 
char  string!  256  ); 

usage_block (0,0); 

for  (  bl cck_nunber  =  0;  b!ock_nunr.ber  number  block;  block  number--*-  ) 
spnntfl  string,  "%s  ”,  block!  block_number  j  ); 

print_list(  yyout,  string,  f ormal_arguT,ent_l i st  [  block_number  ]  ); 
fprintf!  yyout,  "\n"  ); 

pr i nt_var i able_i i st (  yyout,  block_number  ); 
fprintf!  yyout,  ”\n"  ); 

kifdef  DEBUG 

pr  i  nt  _st  atement_l  i  s  t  (  yycut,  statement  list;  dock  number  ;  ); 

fprintf'  yyout,  "\n"  !; 

•  end:  f 
v 

:■  /*  -ummary  */ 
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FILE:  initial /library /uppercase . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
’  Author:  Stephen  R.  Wachtel 

*/ 


char  ’uppercase)  string  ) 
register  char  ’string; 
f 

register  int  index  =  0; 

while  (  stringt  index  ]  !=  '\0'  ) 

{ 

stringt  index  1  »  toupper (  stringt  index 
index++; 

) 

return)  string  ); 

)  /«  uppercase  ’/ 


FILE:  init ial/library/yyerror . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


((include  <stdio.h> 


extern  int  yylineno; 


void  yyerror)  string  ) 
register  char  ’string; 

1 

fprintf(  stderr,  "line  %d,  %s\n",  yylineno, 

exit (  -1  ) ; 

)  /*  yyerror  */ 


FILE:  ini tial /I ibrary/yygetc. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


(•include  <stdio.h> 
‘ttciuae  cctype.h? 


extern  int  yylineno; 


int  tab(  length  ) 
reg  ster  int  length; 
t 

while  (  length —  ’.=  0  ) 
yyunput (  ’  1  ) ; 

return (  •  '  ) ; 

}  /*  tab  */ 


string  )  ; 


int  yygetct  file  ) 
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register  FILE  ‘file; 
( 

int  c; 


int 

column!  6  1; 

loop: 

if 

(  (  c  =  getc(  file  )  )  ==  '\t'  ) 
c  =  tab!  6  ) ; 

if 

(  c  t-  • \n'  ) 
return  (  c  ) ; 

if 

(  (  column!  0  1  =  getc(  file  )  )  !=  * 

goto  abort  0; 

1  ) 

if 

(  (  column!  1  ]  =  getc (  file  )  )  !=  • 

goto  abort  1; 

•  > 

if 

(  (  column!  2  ]  =  getc!  file  )  )  !=  ' 

goto  abort  2; 

•  ) 

if 

(  (  column!  3  ]  =  getc!  file  )  )  !=  ' 

goto  abort_3; 

•  ) 

if 

(  (  column!  4  ]  =  getc!  file  )  )  !=  ' 

goto  abort_4; 

'  ) 

if 

(  isspace!  column!  5  ]  =  getc!  file  ) 
goto  abort  5; 

)  ) 

yylineno++; 

goto  loop; 

abort  5 

: 

if 

(  column!  5  ]  ==  ' \t‘  ) 
tab!  1  ); 

else 

{ 

yyunput!  column!  5  ]  ); 
if  (  column!  5  ]  ==  ’\n‘  ) 

) 

yylineno++; 

abort  4 

. 

if 

(  column!  4  ]  ==  '\t'  ) 
tab (  2  ) ; 

else 


1 

yyunput (  column!  4  ]  ); 
if  (  column!  4  )  =“  '\n'  ) 
yylineno++; 

) 

abort_3 : 

if  (  column!  3  ]  ==  '\t'  ) 
tab!  3  ) ; 

else 

( 

yyunput!  column!  3  ]  ); 

if  (  column!  3  ]  ==  '\n'  ) 
yylineno++; 

) 


abort_2 : 

i  f  (  colu.-  n  [  2  1  ««  '  \t '  ) 
tab (  4  )  ; 

else 

! 

yyunput!  column!  2  !  ); 

if  (  column!  2  i  ==  '\n‘  ) 
yy  1  ineno4-+ ; 


abo  rt_l : 

if  (  column!  1  !  ==  * \t*  ) 
tab (  5  ) ; 

else 

I 

yyunput!  column!  1  1  ); 

if  (  column!  1  )  ==  '\n'  ) 
yyl inenot*; 

) 

abort_0 ; 

i  f  (  column (  0  ]  ==  1 \t '  ) 

tab!  6  ) ; 
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else 

{ 

yyunput (  column!  0  J  ); 
if  (  column!  0  1  ==  * \n'  ) 
yylineno++; 

1 


return (  c  ) ; 
}  /*  yygetc  */ 


FILE:  initial/library/yywrap.  • 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


int  yywrap!  ) 

( 

return (  1  ) ; 
}  /’  yywrap  »/ 


FILE:  initial/scanner . 1 


%( 

/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 

%> 


%a  10000 
%e  10000 
*k  10000 
%n  10000 
%  o  10000 

%p  10000 


a  [aAj 
b  [bB] 
c  [cC] 
d  [  d  D  ] 
e  teEl 
f  !  f  F  ] 
g  [gG] 
h  [hH] 
i  [iU 
j  fjJI 
k  [kK) 
1  1 1 L) 

m  [mM] 
n  [nN] 
o  [oO] 
P  !pF ; 

g  igc: 

r  i  rR] 
s  [  sS  1 
t  [tT] 
u  (uU) 
v  [  vV  i 
w  [wW] 
x  [xX  ] 

y  !yY) 

z  [ZZ] 


%( 

linclude  "grammar. h" 
extern  char  *yy 1 val ; 
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♦  unde f  YYLMAX 
♦define  YYLMAX  (256*20) 


extern  char  'duplicate  (  ); 
extern  char  *hollerith(  ); 
extern  char  *non_blank(  ); 
extern  char  'uppercase (  ); 

%1 


%% 


- [\*cC] .* [\n]  | 

*[\  ) ' f \n]  ( 

♦ifdef  DEBUG 
ECHO; 

#endi f 

yylval  =  duplicate!  yytext  ); 
return (  COMMENT  ); 

) 


(\  1  f 

#i fdef  DEBUG 
ECHO; 

#endi  f 

/*  return!  *\  ■  )  */; 

) 


[U]  ( 

♦ifdef  DEBUG 

rrHO; 

#endi  f 

return  (  1 \S ’  ) ; 

) 


[Ml  ( 

♦ i fdef  DEBUG 
ECHO; 

#endi f 

return  (  1  \  ( 1  )  ; 

) 


[\>  ]  { 

# i fdef  DEBUG 
ECHO; 

#endi f 

return  (  1  \)  '  )  ; 

) 


[\*i  f 
#i fdef  DEBUG 
ECHO; 

#endi f 

return (  ' \*  '  )  ; 

) 


i 

* l faef  DEBUG 
ECHO; 

#endi f 

return!  EXPONENTIATE  )  ; 

1 


[\*1  { 

# i fdef  DEBUG 
ECHO; 

#endi  f 

return  (  '  \+  '  ) ; 

) 
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[\, )  ( 
tifdef  DEBUG 
ECHO; 

#endi f 

return (  ' \, '  ) ; 


[\-l  ( 

(tifdef  DEBUG 
ECHO; 

#endi  f 

return (  1 \- '  ) ; 

} 


f\.)  ( 

tifdef  DEBUG 
ECHO; 

(tendi  f 

return (  ' \ ’  ) ; 

) 


[\/l  ( 

tifdef  DEBUG 
ECHO; 
tendi f 

return (  ' \/ 1  ) ; 

) 


[  \  :  i  i 

tifdef  DEBUG 
ECHO; 
tendi f 

return (  ' \ '  )  ; 

) 


[\  =  ]  ( 
tifdef  DEBUG 
ECHO; 
tendi f 

return (  • \«*  ) ; 

} 


[  \n)  { 

tifdef  DEBUG 
ECHO; 
tendi  f 

/*  return!  '\n'  )  */; 

) 


[\t]  ( 

tifdef  DEBUG 
ECHO; 
tendi f 

/*  return!  '\t'  )  */; 

) 


:  \  !  a )  ( n  M  d  >  :  \ .  ]  { 

*  .  i de  i  DEBUG 
ECHO; 
tendi  f 

return!  RW_AND  ); 

) 


[\. ] let (q) [\. ]  ( 
tifdef  DEBUG 
ECHO; 
tendi f 

return!  RW_EQ  ); 

) 


f  \  .  j  f  e  (  ( q  1  f  v  )  [  \  .  |  ( 
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Kifdef  DEBUG 
ECHO; 

#endi f 

return (  RW_EQV  ); 

1 


[\.]  (fl(a)UHsHe)  [\-l  ( 

#ifdef  DEBUG 
ECHO; 

#endi  f 

return  (  RVi'_FALSE  )  ; 


[\.JfgHe)[\.]  ( 

# i fde  f  DEBUG 
ECHO; 

#endi  f 

return (  RW_GE  ) ; 

) 


1\.) (gift) [\.]  ( 
lifdef  DEBUG 
ECHO; 

#endi  f 

return  (  RW_GT  ); 

1 


[  \  .  H 1 ) i e }[ \  .  1  ( 

# i fdef  DEBUG 
ECHO; 

#endi f 

return)  RW_LE  ); 

> 


[\.l  fl)(t)[\.)  ) 

# i f  de  f  DEBUG 
ECHO; 

#endi  f 

return)  RW_LT  ); 

) 


[\.l Inl(e)  [\-l  ( 

# i fdef  DEBUG 
ECHO; 

#endi  f 

return (  RW_NE  ) ; 

) 


[\. ]  (n) (e) (q) (v) (\.  )  ( 

# i f de  f  DEBUG 
ECHO; 
lendi  f 

return (  RW_NEQV  ) ; 

) 


! \ .  1  InHolltl  [ \ . !  ( 

#i f de  f  DEBUG 
ECHO; 

Henai f 

return  (  RW_NOT  ! ; 

1 


[\.  ) lollr]  [\.  1  { 

# i fdef  DEBUG 
ECHO; 

#endi  f 

return)  RW_OR  ); 

i 


:  \  .  i  )  1 1  ;  r )  ( u  H  e 1  !  \  -  1  I 

* i fdef  DEBUG 
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ECHO; 
lendi f 

return  (  RWTRUE  ); 

1 


# i f de  f  DEBUG 
ECHO; 
lendi f 

return  (  RW_ASSIGN  >; 

1 


(b) (a) (c) (k) f s) |p) (a) (c! (e(  ( 

# i fdef  DEBUG 
ECHO; 
flendi  f 

return!  RW_BACKSPACE  '; 

) 


|b)|lHo)(c|(MI\  l’(d)(a((t)(a!  ! 

#ifdef  DEBUG 
ECHO; 

#endi f 

return (  RW_BLOCK_DATA  ) ; 

i 


icHaiillli)  { 

# i f def  DEBUG 
ECHO; 

*endi  f 

return  (  RW_CALL  ) ; 

} 


!Cl!h|UHrHa|[cHtHeHr|  ( 
#i fdef  DEBUG 
ECHO; 

(te.ndi  f 

return!  RW_CHARACTER  ); 

> 


(c)ilHoHslle)  ( 

# i f de  f  DEBUG 
ECHO; 

*endi f 

return!  RW_CLOSE  ); 

! 


(  c )  f  o )  •  m !  t  m )  (  o )  |  n !  ( 

# i fdef  DEBUG 
ECHO; 

#endi  f 

return!  RW_COMMON  ); 

) 


!  c  M  o  i  ( m )  { p  l  1  i  ;  ( e )  ( x !  { 

* : fde  f  DEBUG 


return!  RWCOMPLEX  ); 

) 


iclio|inllt)lilin)|ujie|  i 
* i f de  f  DE3UG 
ECHO; 
tend i  f 

return  (  R W_C ON T I N U E  ); 

) 


•  d  •  <  a  }  i  ‘  i  f  a  > 

*  i  f  de  f  DEBUs 
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#endif 

return  (  RW_DATA  ); 

} 


|dlli)|m)(eHn)(s)(i)(o)(n)  { 

#ifdef  DEBUG 
ECHO; 

#endi f 

return (  RW_DIMENSION  ) ; 

1 


(d){o)  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_DO  ) ; 

) 


fdMoHuHbXlHe)  (\  1  *  {pH  r  ){e)(  c||  i  H  s)(  i  Ho)  (n)  { 

tifdef  DEBUG 
ECHO; 

#endif 

return (  RW_DOUBLE_PRECISION  ); 

) 


fetflHsHe)  { 
tifdef  DEBUG 
ECHO; 
tendif 

return  (  RW_ELSE  ) ; 

) 


(eHlHsHe)  [\  ]*{iHf)  { 

#i fdef  DEBUG 
ECHO; 

#endi f 

return (  RW_ELSE_1F  ); 

) 


{ e ){ n )f  d )  ( 

# i fdef  DEBUG 
ECHO; 

#endif 

return (  RW_END  ); 

) 


(e ) ( n) (d)  [\  ] * { i H  f }  ( 

t i fdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_END_IF  ) ; 


leHn)(dH£Hi](l)|e)  ( 
itifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_ENDFILE  ); 

) 


(e)(n!(t)|r)(y)  ( 

#ifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_ENTRY  )  ; 

) 


{e)(q((u}{i)(v)(a)(lMe((n){c){el  ( 
tifdef  DEBUG 
ECHO; 
tendi  f 
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return (  RW_EQUIVALENCE  )  ; 

) 


ie)ixHtl(e)(rl|n)|aHll  ( 
lifdef  DEBUG 
ECHO; 

#endif 

return (  RW_EXTERNAL  ); 

1 


{ f ) lo) i r ) (m) (a) { t } . *  { 
lifdef  DEBUG 
ECHO; 
lendi f 

yylval  =  duplicate!  yytext  ); 
return (  RW_FORMAT  ) ; 

1 


IfHulInHcHtHilloHnl  ( 
lifdef  DEBUG 
ECHO; 
lendif 

return!  RW_FUNCTION  ); 

1 


(gl(o)  [\  IMtllol  { 
lifdef  DEBUG 
ECHO; 
lendi f 

return!  RW_GO_TO  ); 

) 


(  i  )  t  f  t  ( 

lifdef  DEBUG 
ECHO; 
lendif 

return!  RW_IF  ); 

1 


(  i}{m)(p)  U)  UHcHiHt)  ( 
lifdef  TEBUG 
ECHO; 
lendif 

return  (  RW_IMPLIC1?  ) ; 

> 


(i>!n>fcHl)(u){d)<el  ! 
lifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_INCLUDE  ) ; 

) 


(i) !n> |q) (u){i}{r) (e)  ( 

lifdef  DEBUG 
ECHO; 
lendi f 

return!  RW_INQUIRE  ); 


(i)(n)(t)(e)|g)(e)(r)  ! 

lifdef  DEBUG 
ECHO; 
lendif 

return!  RW_INTEGER  ); 

) 


!i)(n)(t)(r)(i)(n)fs)(i((c| 
lifdef  DEBUG 
ECHO; 
lendi  f 
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return (  RW_INTRINSIC  >; 

) 


UHollgHiUcHaHl)  { 
lifdef  DEBUG 
ECHO; 

#endif 

return (  RW_LOGICAL  ); 

) 


ln)|aHm)|e)(lHil!s)(tl  ( 
(tifdef  DEBUG 
ECHO; 

#endif 

return  (  RW_NAMELIST  ) ; 

) 


(o)lpHel(nl  { 

# i f def  DEBUG 
ECHO; 

#endif 

return  (  RW_OPEN  ) ; 

} 


ip){a}{r}{a){m)(e){t){e){r)  ( 

tifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_PARAMETER  ) ; 

) 


{p)(a)fu){s)(e}  ( 

ffifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_PAUSE  ) ; 

1 


IpKrUiMnHt)  { 

#ifdef  DEBUG 
ECHO; 

#endi  f 

return  (  RW_PRINT  ) ; 

} 


(p) { r } (o) (g) { r ) ( a ) (m)  ( 

#i fdef  DEBUG 
ECHO; 

(tendi  f 

return (  RW_PROGRAM  )  ; 

1 


IrlleHaHdl  { 

# i fdef  DEBUG 
ECHO; 

#endi  f 

return!  RW  READ  >; 


(r)(e)|a)(l)  ( 

# i fdef  DEBUG 
ECHO; 

#endi  f 

return!  RW_REAL  ); 

) 


(i)(e||tHul!r]|nl  ( 

# i fdef  DEBUG 
ECHO; 

#endi f 

return!  RW  RETURN  ); 
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) 


(rl(e)(w)|i)(nlld)  { 
tifdef  DEBUG 
ECHO; 

#endi f 

return (  RW_REWIND  >; 

) 


|s)|a)(v)(e)  { 

(tifdef  DEBUG 
ECHO; 

(tendif 

return (  RW_SAVE  ) ; 

) 


(sHtHo)lp)  { 

#ifdef  DEBUG 
ECHO; 

(tendif 

return (  RW_STOP  ); 

) 


(s||u)(bHrHo)(uHtl(i){nHe)  { 
#ifdef  DEBUG 
ECHO; 

(tendif 

return (  RW_SUBROUTINE  ); 

) 


(t)ih)|e)inl  { 

#i fdef  DEBUG 
ECHO; 

(tendif 

return (  RW_THEN  ) ; 

1 


(tllol  { 

#ifdef  DEBUG 
ECHO; 

#endif 

return!  RW_TO  ); 

1 


(w) (r) f i)ft}(e)  { 

#ifdef  DEBUG 
ECHO; 

#endi f 

return (  RW_WRITE  ) ; 

) 


(u|(n|id)(e)(fHil(n)(eHdl  f 
# i fdef  DEBUG 
ECHO; 

#endi  f 

return  (  RW_UNDEFINED  ) ; 

t 


(»a-zA-Z] [_a-zA-Z0-9] *  { 

#i fdef  DEBUG 
ECHO; 
lendi f 

yylval  »  duplicate!  uppercase!  yytext  )  ); 

return!  IDENTIFIER  ); 

) 


"[0-9  1 [0-9  ) [ 0-9  1(0-9  1(0-9  )f\  ]  { 

(tifdef  DEBUG 
ECHO; 

(tendi  f 

yylval  =  duplicate!  nor._bian*  (  yytext  )  ); 
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return (  LABEL  ); 


[0-9]+  | 

[0-9)+/\. [a-zA-Z]+\.  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

yylval  =  duplicate!  yytext  ); 
return (  INTEGER  )  ; 


[0-9] +\. [0-9] * ( [eE] [\+\-] ? [0-9] +) ? 
[0-9] *\ . [0-9] + ( [eE] [\+\-] ?[0-9]+) ? 
[0-9]  +  ( [eE]  [\+\-] ? [0-9] +) ?  ( 

#ifdef  DEBUG 
ECHO; 

#endi f 

yylval  =  duplicate!  yytext  ); 
return  (  REAL  ) ; 

> 


[0-9]+\.[0-9]*([dD]  [\  +  \-]?[0-9]+>?  I 
[0-9] *\. [0-9] + ( [dD] [\+\-] ? [0-9] +) ?  | 

[0-9]  +  ([dD]  [\  +  \-]?[0-9]  +  >  ?  { 

#’fdef  DEBUG 
ECHO; 

#e.ndif 

yylval  =  duplicate!  yytext  ); 
return!  DOUBLE_PRECISION  ); 

) 


\ ■ \ * ) *\ *  I 

\,,r\"]*\"  ( 

#ifdef  DEBUG 
ECHO; 

#endi  f 

yytext [  0  ]  =  • ‘ ; 

yytext [  strlen!  yytext  )  -  1  ]  =  'V"; 
yylval  =  duplicate!  yytext  ); 
return (  STRING  ) ; 

) 


[0-9]  +  [hH]  ( 
ffifdef  DEBUG 
ECHO; 

(tendif 

yylval  =  duplicate!  hollerith!  yytext.  ' \" •  )  ); 
return!  HOLLERITH  ); 

) 
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15.  Appendix  J:  namelist  program  source 

FILE:  namel i st /Makef i le 


* 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


default:  namelist 


CC  =  cc  -g 
INCLUDE  =  include 
CFLAGS  *  -IS (INCLUDE) 

LIBRARY  =  statement/statement . a  library/library. a 


OBJECTS  =  \ 

S (INCLUDE) /grammar. h  \ 
•grammar. [co]  \ 
•scanner. (coj  \ 
yy trace. [co]  \ 
y . output 


PROGRAMS  =  \ 
•namelist 


grammar. c:  grammar. y 
yacc  -dv  grammar. y 
mv  y.tab.h  S (INCLUDE) /grammar . h 
mv  y.tab.c  grammar.c 

scanner. c:  scanner. 1 

lex  -vt  scanner. 1  >scanner.c 


scanner. o:  scanner. c  $( INCLUDE) /grammar . h 
S (CC)  S (CFLAGS)  -c  scanner. c 

grammar. o:  grammar. c 

$ (CC)  $ (CFLAGS)  -c  grammar. c 

namelist:  grammar. o  scanner. o  S (LIBRARY) 

S (CC)  -o  namelist  grammar. o  scanner. o  S (LIBRARY) 


sgrammar .  c:  grammar . c  yytoken.awk 

awk  -f  yytoken.awk  kgrammar.c  >sgrammar.c 

sgrammar. o:  sgrammar. c 

S (CC)  S (CFLAGS)  -c  sgrammar. c 

snamelist:  sgrammar. o  scanner. o  $ (LIBRARY) 

S (CC)  -o  snamelist  sgrammar. o  scanner. o  S(LIBRARY) 


dscanner.c:  scanner. c 

cp  scanner. c  dscanner.c 

dscanner.o: dscanner.c  $ (INCLUDE) /grammar. h 
$(CC)  S (CFLAGS)  -DDEBUG  -c  dscanner.c 

dnamelist:  grammar. o  dscanner.o  S (LIBRARY) 

S (CC)  -o  dnamelist  grammar. o  dscanner.o  S (LIBRARY) 


tgramma  r . c : grammar . c 

sed  '  s/yy  stack :/ S  yytrace  (yystate)  /  '  kgrammar.c  >tgrammar.c 


tgrammar.o: tgrammar.c 

S(CC)  S (CFLAGS)  -c  tgrammar.c 
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tnamelist:  tgrammar.o  scanner. o  yytrace.o  S (LIBRARY) 

$ (CC)  -o  tnamelist  tgrammar.o  scanner. o  yytrace.o  $ (LIBRARY) 


yytrace.c:  grammar. c  yytrace.awk 

awk  -f  yvtrace.awk  <y. output  >yytrace.c 

yytrace.o:  yytrace.c 

S(CC)  $ (CFLAGS)  -c  yytrace.c 


clean: 

cd  library;  make  clean 
cd  statement;  make  clean 
rm  -f  $  (PROGRAMS)  S (OBJECTS) 


FILE:  namelist /grammar . y 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


%token  CONTROL 
%token  DOUBLE_PRECISION 
%token  IDENTIFIER 
%token  INTEGER 
%token  REAL 
%token  STRING 


%right  •=' 
%left  '+■ 


*( 

typedef  char  ‘POINTER; 
#def ine  YYSTYPE  POINTER 

((include  "namelist. h" 

*) 


%% 


program: 

statement  list 


statement_list : 

statement 

I 

statement  list  statement 


statement : 

control_statement 

assignment_statement 


control_statement : 

CONTROL 

( 

control_statement (  $1  ); 

) 


assignment_statement : 

variable  constant_list 

( 
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assignment_statement (  SI,  S3  ); 

) 


variable : 

^ r  ■  -Tr,-rpp 

1 

$$  =  SI; 

1 

I 

IDENTIFIER  • (■  integer_list  •)' 

1 

S$  -  merge  (  "%s<%s)*\  SI.  S3  ); 
free (  $1  )  ; 
f  ree (  S3  )  ; 

1 


integer_list : 

INTEGER 

{ 

$$  -  $1; 

1 

I 

integer_list  INTEGER 

{ 

$S  »  merge (  "%s,ts",  $1,  S3  >; 
free(  SI  ); 
free (  S3  >; 

1 


constant_list: 

constant  optional_comma 

{ 

SS  =  merge (  ” {%s}" ,  SI  ); 
free (  $1  ); 

) 

I 

constant_llst  constant  optional  comma 

( 

$$  -  merge (  ”%s(%s)",  SI,  S2  ) ; 
free (  $1  ) ; 
free  <  $2  ) ; 

) 


optional  comma: 

/»  NULL  */ 

I 


constant : 

STRING 

{ 

SS  =  SI; 

1 

I 

signed_constant 

( 

SS  =  number (SI); 

) 

I 

INTEGER  signed_constant 

{ 

SS  =  merge!  "%s*%s",  SI,  number  (S3)  ); 
free  (  SI  )  ; 
free (  S3  )  ; 

} 


signed_constant : 

unsigned_constant 

( 
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$$  =  $1; 

) 

I 

sign  unsigned_constant 

f 

SS  =  merge (  "%s%s",  SI,  $2  ); 
free  (  S2  ) ; 

) 


sign: 

•  +  ■ 

{ 

SS  =  duplicate (  "+"  ); 

} 


f 

SS  *  duplicate (  ); 

} 


unsigned_cor.stant : 
INTEGER 
( 

SS  =■  $1; 

) 

I 

REAL 

( 

SS  -  SI; 

1 

I 

DOUBLE_PRECISION 

1 

SS  =  SI; 

1 


%% 


FILE :  namel i st /include/namelist .h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  int  count (  ) ; 
extern  char  ‘duplicate!  ), 
extern  char  *list<  ); 
extern  char  ‘lowercase!  ), 
extern  char  ‘merge!  ); 
extern  char  ‘parse!  ); 
extern  char  ‘number!  ); 


FILE:  namel ist/library /Makefile 


» 

#  Copyright  1991 

It  Georgia  Institute  of  Technology 
It  Computer  Engineering  Research  Laboratory 
§  Author:  Stephen  R.  Wachtel 

* 


CC  -  cc  -g 
INCLUDE  =  . . /include 
CFLAGS  =  -IS (INCLUDE) 
LIBRARY  =  library. a 
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OBJECTS  =  \ 
count. o  \ 
duplicate. o  \ 
list.o  \ 

ma i n . o  \ 

margin_printf -o  \ 
numberTo  \ 
we roe. o  \ 
parse. o  \ 
yyerror.o  \ 
yywrap. o 


$ (LIBRARY) : S (OBJECTS) 

ar  crv  $ (LIBRARY)  $ (OBJECTS) 
ranlib  S (LIBRARY) 


•SUFFIXES:  .c  .o 
.  c.  o: 

$(CC)  -c  $ (CFLAGS)  $< 


clean: 

rir.  -f  < (LIBRARY)  S  (OBJECTS) 


FILE:  namelist /library/count . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


int  count (  string,  length,  c  ) 
register  char  ‘string; 
register  int  length; 
register  char  c; 

{ 

register  int  c_count  *  0; 

while  (  length  !=  0  ) 

( 

if  (  ‘string  ==  c  ) 
c_count++; 

string++; 

length — ; 

) 

return!  c  count  ); 

)  /*  count  */~ 


FILE:  name list /library /duplicate . c 


/* 

*  Copyright  1991 

»  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  <malloc.h> 


char  ‘duplicate!  string  ) 
register  char  ‘string; 

( 


register  char  ‘temporary  =  (char  ‘(NULL; 
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if  (  string  !=  (char  '(NULL  ) 

( 

if  (  (  temporary  =  (char  *,'malloc(  strlen<  string  )  +  1  )  )  !=  (char 

strcpy(  temporary,  string  ); 

else 

fp.i.\tf(  stdc  :r,  “ERRCR:  duplicate!  4s  /\n",  string  i; 


return (  temporary  ) ; 
1  /'  duplicate  */ 


FILE:  namelist/library/list .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


extern  char  'parse  (  ); 
extern  char  'merge (  ); 


char  *list(  input_list,  delimeter  ) 
register  char  *input_list; 
register  char  'delimeter; 

! 

register  char  *output_list; 
register  char  'list; 
register  char  'temporary; 

output_list  =  parse (  input_list  ); 
list  »  parse (  input_list  ); 

while  (  list  ! =  (char  *)0  ) 

{ 

temporary  *=  merge  (  "%s%s%s",  output_list,  delimeter,  list  >; 

free!  output_list  ); 
free (  list  ) ; 

output_list  =  temporary; 
list  =  parse (  input_list  ); 

1 

return)  output_list  ); 

}  /*  list  */ 


FILE :  namelist /library /lowercase . c 


/' 

'  Copyright  1991 

'  Georgia  Institute  of  Technology 
*  Computer  Engineering  Research  Laboratory 
'  Author:  Stephen  R.  Wachtel 
*/ 


char  'lowercase (  string  ) 
register  char  'string; 

( 

register  int  index  =  0; 

while  (  string!  index  ]  !=  '\0'  ) 

{ 

string!  index  ]  =  tolowerl  string!  index  ]  ); 
index++; 

) 

return (  string  ) ; 

}  /*  lowercase  */ 


'(NULL  ) 


FILE:  namelist/1 ibrary /main . c 
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/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  riachter 

»/ 


♦include  <stdio.h> 


extern  FILE  ‘yyin; 
extern  FILE  ‘yyout; 


((define  PROGRAM  argument  [  G  ) 
♦define  INPUT_FILE  argument!  1  ) 
♦define  OUTPUT_FILE  argument [  2  ] 


int  main!  number_argument,  argument  ) 
int  number_argument; 
char  'argument [  ] ; 

{ 

if  (  number_argument  ==  1  ) 

{ 

yyin  -  Stdin; 
yyout  ■  stdout; 

yyparse (  ) ; 
exit (  0  ) ; 

> 

if  (  number_argument  ==  3  ) 

< 

if  (  (  yyin  -  f open (  INPUT  FILE,  "r"  )  >  —  (FILE  ‘(NULL  ) 

( 

fprintf(  stderr,  "%s:  ERROR  -  unable  to  open  input  file  ,%s'\nh,  PROGRAM, 
INPUT_FILE  ) ; 

exit!  -1  ); 

1 


if  (  (  yyout  -  fopen (  OUTPUT  FILE,  “w"  )  )  ==  (FILE  ‘(NULL  ) 

( 

fprintfl  stderr,  ”%s:  ERROR  -  unable  to  open  output  file  ,%s'\n",  PROGRAM, 
OUTPUT_FILE  ) ; 

exit  (  -1  ); 

) 


yyparse (  ) ; 
exit (  0  )  ; 


fprintff  stderr,  "usage:  %s  <input  file>  <output  file>\n",  PROGRAM  ); 
exit  (  0  ) ; 

}  /*  main  •/ 


FILE:  namelist/library/margin_print f . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <string.h> 


extern  FILE  *yyin; 
extern  TILE  *yyout; 


static  void  output_buf fer (  file,  buffer  ) 
register  FILE  ‘file; 


15.  Appendix  1:  namelist  program  source 


335 


register  char  ‘buffer; 

( 

♦define  LENGTH  72 

int  length  =  LENGTH; 
int  continuation  =  0; 
int  quote  -  0; 
char  temporary; 

while  (  strlen)  buffer  )  >  length  ) 

{ 

if  (  continuation++  !=  0  ) 

fprintf (  file,  “  S"  ) ; 

quote  +=  count)  buffer,  length,  ' ); 
if  (  (  quote  %  2  )  ==  0  ) 

( 


while  < 

1  length  ! 

=  0  ) 

t 

if 

(  buffer) 
break; 

length  -  Q  ) 

==  *\ 

if 

(  buffer) 
break; 

length  -  1  ] 

==  *\ 

length — ; 

1 

if  (  length  ==  0  ) 

1 

fprintf)  stderr,  "ERROR:  margin_printf ( ) \n"  ); 
exit (  -1  ) ; 

) 

1 

temporary  =  buffer)  length  ]  ; 
buffer)  length  ]  =  'NO'; 
fprintf)  file,  ”%s\n”,  buffer  ); 
buffer)  length  )  =  temporary; 

strcpy)  sbuffer)  0  ],  Sbuffer)  length  ]  ); 
length  -  LENGTH  -  6; 


if  (  strlen)  buffer  )  0  ) 

{ 

if  (  continuatlon++  !=  0  ) 

fprintf)  file,  "  S"  ); 

fprintf)  file,  "%s\n”,  buffer  ); 

) 

(  /*  output_buf fer  */ 


void  margin_print f (  buffer  ) 
char  ‘buffer; 

{ 

buffer)  strlen)  buffer  )  —  1  ]  =  ’\0'; 
while  (  buffer)  strlen)  buffer  )  -  1  )  ==  '  '  ) 
buffer)  strlen)  buffer  )  -  1  )  =  *\0'; 

lifdef  PASSTHRU 

fprintf)  yyout,  "%s\n",  buffer  ); 

♦  else 

switch  (  buffer)  0  ]  ) 

l 

case  ' NO 1 : 

fprintf)  yyout,  "\n"  ); 


break 

case 

case 

*  c ' : 

case 

fC'  : 

case 

fprintf)  yyout,  "»s\n",  buffer  ); 
break; 

default : 

output_bu f fer (  yyout,  buffer  ); 

) 

♦endi f 
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buffer!  0  )  =  '\0'; 
)  /*  margin_print f  */ 


FILE:  namelist/library/merge,  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  <malloc.n> 


♦define  STRLEN (  s  )  (  strlen!  s  )  -  2  ) 


char  'merge (  string,  a,  b,  c,  d  ) 

register  char  'string; 

register  char  'a; 

register  char  *b; 

register  char  'c; 

register  char  *d; 

( 

register  char  'temporary  =  {char  '(NULL; 

switch  (  count  (  string,  strlen(  string  ),  'V  )  ) 

( 

case  0: 

if  (  (  temporary  =  (char  *)malloc(  strlent  string  )  +  1  )  )  !=  (char  '(NULL  ) 

sprintf(  temporary,  string  ); 

else 

fprintfl  stderr,  "ERROR:  merge (  %s  )\n“,  string  ); 

break; 

case  1 : 

if  (  (  temporary  =  (char  *)malloc(  strlent  string  )  +  STRLEN (  a  )  +  1  )  )  1 = 

(char  * ) NULL  ) 

sprintfl  temporary,  string,  a  ); 

else 

fprintfl  stderr,  "ERROR:  merge)  %s,  %s  )\n",  string,  a  ); 

break; 

case  2: 

if  (  (  temporary  =  (char  *)malloc(  strlenl  string  )  +  STRLEN!  a  )  +  STRLEN (  b 
)  +  1  )  )  !  =*  (char  * )  NULL  ) 

sprintfl  temporary,  string,  a,  b  ); 

else 

fprintfl  stderr,  "ERROR:  merge!  4s,  %s,  4s  )\n",  string,  a,  b  ); 

break; 

case  3: 

if  (  (  temporary  =  (char  *)malloc(  strlent  string  )  +  STRLEN!  a  )  +  STRLEN!  b 
)  +  STRLEN!  c  )  +  1  )  )  !=  (char  '(NULL  ) 

sprintfl  temporary,  string,  a,  b,  c  ); 

else 

fprintfl  stderr,  "ERROR:  merge!  4s,  4s,  4s,  4s  )\n”,  string,  a,  b,  c  ); 

break; 

case  4: 

if  (  (  temporary  »  (char  '(rnalloc!  strlen!  string  )  +  STRLEN!  a  )  +  STRLEN!  o 
)  +  STRLEN!  c  )  +  STRLEN!  d  )  +  1  )  )  !=  (char  '(NULL  ) 
sprintf!  temporary,  string,  a,  b,  c,  d  ); 

else 

fprintfl  stderr,  "ERROR:  merge!  4s,  4s,  4s,  4s,  4s  ) \n",  string,  a,  b,  c,  d 

)  ; 

break; 

default : 

fprintfl  stderr,  "ERROR:  merge!  4s  )\n",  string  ); 

break; 

) 


return!  temporary  ); 
)  /'  merge  '/ 
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FILE:  namelist/library/number . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <string.h> 


char  "number (  string  ) 
register  char  "string; 

I 

if  (  strncmp!  string,  1  )  ==  0  ) 

strcpy!  Sstring[0],  Sstringfl)  ); 

if  (  strchr!  string,  )  !=  0  ) 

( 

while  (  st ring [ strlen ( st ring) -1 ]  ==  'O'  ) 
string[strlen (string) -1)  =  '\0'; 

if  (  strcmp(  "-0.",  string  )  ==  0  ) 
strcpy(  Sstring[0],  Sstring(l!  ); 

) 

return!  string  ); 

)  /*  number  */ 


FILE:  namelist/library/parse. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <string.h> 


extern  char  "duplicate!  ); 


char  "parse!  list  ) 
register  char  "list; 

( 

register  int  length  =  0; 

register  int  brace  =  0; 

register  char  "temporary  =  (char  *)0; 

for  <;;) 

{ 

switch  (  list[  length  )  ) 

{ 

case  '  (  1  : 

brace++; 

break; 

case  ' ) ' : 

brace--; 

break; 

) 

if  (  brace  =*=*  0  ) 
break; 

length++; 

) 

if  (  length  !=  0  ) 

1 i  • t  C  length  1  =  ’ \0  ' ; 
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temporary  =  duplicate (  list  +  1  ); 
strepyl  list,  list  +  1  +  length  ); 

) 

else 

( 

if  (  list!  length  ]  !=  '\0'  ) 

( 

temporary  =  duplicate (  list  ); 
list[  length  1  =  ' \0‘; 

) 


return (  temporary  ) ; 
1  /*  parse  */ 


FILE:  namelist/library/yyerror.  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
»/ 


♦include  <stdio.h> 


extern  int  yylineno; 


void  yyerror (  string  ) 
register  char  ‘string; 

( 

fprintf(  stderr,  "line  »d,  %s\n'\  yylineno,  string  ); 

exit  (  -1  )  ; 

)  /»  yyerror  */ 


FILE:  namelist/library/yywrap.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


int  yywrapl  ) 

( 

return (  1  ) ; 
}  /*  yywrap  */ 


FILE:  namelist/scanner, 1 


%! 

/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 

%) 


a  [aA] 
b  (bB) 
c  [  cC  ] 
d  [dDJ 
e  [eEl 
f  [fF] 
g  tgGl 
h  [hHJ 
i  [ill 
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j  [jJl 
k  [  kK  1 
1  [1LJ 
m  [mM] 
n  [nN] 
o  [ooj 
P  [pP ) 
q  [qQJ 
r  CrR) 
s  [sSJ 
t  [tT] 
u  [uUl 
v  [vVJ 
w  rwW] 
x  [xX] 

y  CyYl 
z  tzZ] 


%{ 

dinclude  "grammar. h" 
extern  char  *yylval; 


#include  "namelist. h" 

») 


»% 


l\  1  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

/*  return (  •  ■  )  */; 

) 


t\nl  { 

#ifdef  DEBUG 
ECHO; 

#endif 

/*  return (  '\n'  )  */; 

1 


[\t  1  ( 

#ifdef  DEBUG 
ECHO; 

(tend!  f 

/*  return!  • \ t •  )  */; 

) 


t\  +  )  ( 

#i fdef  DEBUG 
ECHO; 

#endif 

return (  ■ + '  ) ; 

I 


[\-l  ( 

#i fdef  DEBUG 
ECHO; 
dendi f 

return  (  ' - '  ) ; 

1 


[\<]  { 
difdef  DEBUG 
ECHO; 
dendi f 

return (  ‘ ( '  ) ; 

) 


[\>  1  ( 

di fdef  DEBUG 
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ECHO; 

Iendif 

return (  * ) '  ) ; 

) 


E\*l  ( 
lifdef  DEBUG 
ECHO; 

Iendif 

return (  ' * '  ) ; 

) 


[\.  1  1 
lifdef  DEBUG 
ECHO; 

#endif 

return (  • , •  ) ; 

) 


[\=]  < 
lifdef  DEBUG 
ECHO; 

#endif 

return (  ' = ■  ) ; 

) 


[a-zA-21 [_a-zA-Z0-9] *  { 

lifdef  DEBUG 
ECHO; 

Iendif 

yylval  »  duplicate (  lowercase!  yytext  )  ); 
return  (  IDENTIFIER  ); 

1 


[0-91+  { 

lifdef  DEBUG 
ECHO; 

Iendif 

yylval  *  duplicate!  yytext  ); 
return (  INTEGER  ) ; 

1 


[  0-9]  +  \  •  [0-9]  *  (  [eE]  [\+\-]?[0-9]+J?  I 
[0-9] *\. [0-91+ ( [eEl [\+\-] ? [0-9] +) ?  I 
( 0-9]  +  ( [eE]  [\  +  \-l ? [0-9] +) ?  { 
lifdef  DEBUG 
ECHO; 

Iendif 

yylval  =  duplicate!  yytext  ); 
return (  REAL  ) ; 

1 


[0-9] +\. [0-9]* ( [dO] [\+\-l ? [0-9] +) ?  | 

[0-9]*\.[0-9]  +  ([dD]  [ \+\  —  ]  ?  [0-9]  +)  ?  | 

[0-9]  +  ( [ dD ]  [\+\-] ? [0-9] +) ?  { 
lifdef  DEBUG 
ECHO; 
lendi f 

yylval  »  duplicate!  yytext  ); 
return!  DOUBLE_PRECISION  ); 

] 


S  '  [* \ '  ]  *\ '  ! 
lifdef  DEBUG 
ECHO; 
lendi f 

yylval  =  duplicate!  yytext  ); 
return!  STRING  ); 

> 


S(  a-zA-ZO-9] +  ( 
lildef  DEBUG 
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ECHO; 

#endi f 

yylval  =  duplicate (  yytext  ); 
return (  CONTROL  ); 


FILE:  namelist/ statement /Make file 


# 

♦  Copyright  1991 

♦  Georgia  Institute  of  Technology 

♦  Computer  Engineering  Research  Laboratory 

♦  Author:  Stephen  R.  Wachtel 

♦ 


CC  =  cc  -g 
INCLUDE  =  ../include 
CFLAGS  =  -1$ (INCLUDE) 
LIBRARY  =  statement. a 


OBJECTS  =  \ 

assignment_statement .  o  \ 
control  statement. o 


S (LIBRARY) : $ (OBJECTS) 

ar  crv  S (LIBRARY)  $ (OBJECTS) 
ranlib  $ (LIBRARY) 


■SUFFIXES:  .c  .o 
.  c.  o: 

$(CC)  -c  $  (CFLAGS)  $< 


clean: 

rm  -f  $ (LIBRARY)  S (OBJECTS) 

FILE:  namelist/statement/assignment_statement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 
♦include  <string.h> 


extern  char  *list<  ); 


void  assignment_statement (  variable,  constant_list  ) 
register  char  'variable; 
register  char  *constant_list; 

{ 

♦define  BUFFER  4096 

char  buffer!  BUFFER  ]; 

constant_list  =  list(  constant_list,  ",  "  ); 

if  (  (  strlenf  variable  )  +  strlen(  constant  list  )  + 

( 

sprintf(  buffer,  "  DATA  %s  /%s/\n",  variable, 

margin_print f (  buffer  ); 

) 

else 

fprintff  stderr,  "ERROR:  assignment_statement ( ) \n" 

free (  variable  ) ; 
free(  constant_l i st  ); 

(  /*  assignment_statement  */ 


15  )  <  BUFFER  ) 
constant_l ist  ); 

) ; 
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FILE:  namelist/statement/control  statement. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 
♦include  <string.h> 


void  control_statement (  string  ) 
char  ‘string; 

{ 

♦define  BUFFER  4096 

char  buffer t  BUFFER  ]; 

string!  0  1  » 

if  (  (  strlen (  string  )  +  1  )  <  BUFFER  ) 

< 

sprintft  buffer,  "%s\n“,  string  ); 
margin_printf (  buffer  ); 

) 

else 

fprintf(  stderr,  "ERROR:  control_statement () \n“  ); 

free(  string  ); 

)  /*  control  statement  */ 
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16.  Appendix  K:  network  program  source 

FILE:  network/communication/Makef ile 


* 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

t  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


default:  communication 


CC  =  cc  -g 
INCLUDE  =  include 
CFLAGS  =  -IS (INCLUDE) 
LIBRARY  =  library/library. a 


OBJECTS  -  \ 

S (INCLUDE) /grammar. h  \ 
♦grammar. [co]  \ 
♦scanner. [co]  \ 
yy trace. [co!  V 
y. output 


PROGRAMS  »  \ 

♦communication 


grammar. c:  grammar. y 
yacc  -dv  grammar. y 
mv  y.tab.h  S (INCLUDE) /grammar. h 
mv  y.tab.c  grammar. c 


scanner. c:  scanner. 1 

lex  -vt  scanner. 1  I  sed  ‘ s/getc/yygetc/ '  >scanner.c 


scanner. o:  scanner. c  $ (INCLUDE) /grammar. h 
$<CC)  S (CFLAGS)  -c  scanner. c 

grammar. o:  grammar. c 

S (CC)  $ (CFLAGS)  -c  grammar. c 

communication:  grammar. o  scanner. o  S (LIBRARY) 

$ (CC)  -o  communication  grammar. o  scanner,  o  $ (LIBRARY) 


sgrammar . c: grammar . c  yytoken.awk 

awk  -f  yytoken.awk  <grammar.c  >sgrammar.c 

sgrammar. o: sgrammar. c 

S (CC)  S (CFLAGS)  -c  sgrammar. c 

scommunication:  sgrammar. o  scanner. o  S (LIBRARY) 

$(CC)  -o  scommunication  sgrammar. o  scanner. o  S(LIBRARY) 


dscanner.c:  scanner. c 

cp  scanner. c  dscanner.c 

dscanner.o:  dscanner.c  $ (INCLUDE) /grammar. h 
$<CC)  $ (CFLAGS)  -DDEBUG  -c  dscanner.c 

dcommunicat ion :  grammar. o  dscanner.o  S (LIBRARY) 

S (CC)  -o  dcommunication  grammar. o  dscanner.c  S(LIBRARY) 


t grammar .  c :  grammar . c 

sed  '  s/yystack  : /S  yy t race (yy state );/ '  <gra;nmar.c  >tgrammar.c 


tgrammar.o: tgrammar.c 

$(CC)  S (CFLAGS)  -c  tgrammar.c 
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tcommunication:  tgrammar.o  scanner. o  yytrace.o  $ (LIBRARY) 

$ (CC)  -o  tcommunication  tgrammar.o  scanner. o  yytrace.o  $ (LIBRARY) 


yytrace.c:  grammar. c  yytrace.awk 

awk  -f  yytrace.awk  <y. output  >yytrace.c 

yytrace.o:  yytrace.c 

$(CC)  $ (CFLAGS)  -c  yytrace.c 


clean: 

cd  library;  make  clean 
rm  -f  $ (PROGRAMS)  $ (OBJECTS) 


FILE:  net work /communication /grammar . y 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


/* 

»  FORTRAN  77 

*/ 


%token  RW_AND 
%token  RW_ASSIGN 
%token  RW_BACKSPACE 
♦token  RW_BLOCK_DATA 
%token  RW_CALL 
♦token  RW_C HARAC TER 
♦token  RW_CLOSE 
♦token  RW_COMMON 
♦token  RW_COMPLEX 
♦token  RW_CONTINUE 
♦token  RW_DATA 
♦token  RW_D I MEN SION 
♦token  RW_DO 

♦token  RW_DOUBLE_PRECISION 

♦token  RW_ELSE 

♦token  RW_ELSE_IF 

♦token  RW_END 

♦token  RW_END_IF 

♦token  RW_ENDFILE 

♦token  RW_ewtrY 

♦token  RW_EQ 

♦token  RW_EQU I VALENCE 

♦token  RW_EQV 

♦token  RW_EXTERNAL 

♦token  RW_FALSE 

♦token  RW_FORMAT 

♦token  RW_F UNCTION 

♦token  RW_GE 

♦token  RW_GO_TO 

♦token  RW_GT 

♦token  RW_IF 

♦token  RW_IMPLICIT 

♦token  RW_INCLUDE 

♦token  RW_INQUIRE 

♦token  RW_INTEGER 

♦token  RW_INTRINSIC 

♦token  RW_LE 

♦token  RW_LOGICAL 

♦token  RW_LT 

♦token  RW_NAMELIST 

♦token  RW_NE 

♦token  RW_NEQV 

♦token  RW_NOT 

♦token  RW_OPEN 

♦token  RW_OR 

♦token  RW_PARAMETER 

♦token  RW_PAUSE 

♦token  RW_PRINT 

♦token  RW  PROGRAM 
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♦token  RW_READ 
♦token  RW_REAL 
♦token  RW_RETURN 
♦token  RW_REWIND 
♦token  RW_SAVE 
♦token  RW_STOP 
♦token  RW_SUBROUTINE 
♦token  RW_THEN 
♦token  RW_TO 
♦token  RW_TRUE 
♦token  RW_WRITE 
♦token  RW  UNDEFINED 


♦token  COMMENT 
♦token  CONCATENATE 
♦token  DOUBLE_PRECISION 
♦token  EXPONENTIATE 
♦token  HOLLERITH 
♦token  IDENTIFIER 
♦token  INTEGER 
♦token  LABEL 
♦token  REAL 
♦token  STRING 


♦left  *,* 

♦nonassoc  ' : 1 
♦right  ■=■ 

♦left  RW_EQV  RW_NEQV 
♦left  RW_OR 
♦left  RW_AND 
♦left  RW_NOT 

♦nonassoc  RW_EQ  RW_NE  RW_LT  RW_LE  RW_GT  RW_GE 
♦left  CONCATENATE 
♦left  •+■ 

♦left  •/' 

♦right  EXPONENTIATE 
♦left  SIGN 


♦  < 

typedef  char  ‘POINTER; 

#def ine  YYSTYPE  POINTER 

♦include  ”list.h" 

static  LIST  *block_list  =  0; 

static  LIST  *call_list; 

static  POINTER  block_name; 
static  POINTER  block_type; 

extern  POINTER  array (  ) ; 
extern  POINTER  duplicate (  ); 
extern  POINTER  merge '  )  ; 

♦  ) 


♦  ♦ 


program: 

optional_statement_list 

( 

summary!  block_list  ); 

) 


optional  statement_l ist : 
r*  NULL  */ 

I 

statement  list 


statement_l i st : 

statement 

I 

statement  list  statement 
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statement : 

comment  statement 
I 

label  unlabeled  statement 


comment_statement : 
COMMENT 


label: 

LABEL 


unlabeled_statement : 

include_statement 

I 

program  statement 
I 

bloc)c_data_statement 

I 

function_statement 

I 

subrout ine_st at ement 
I 

entry_statement 

I 

end_statement 

I 

specificatlon_statement 

I 

executablestatemci.t 

I 

format  statement 


include_statement : 

RW  INCLUDE  character  constant 


program_statement : 

RW_PROGRAM  program_identi f ier 


program_identi f ier : 

IDENTIFIER 

< 

block_name  =  $1; 

block_type  «  duplicate!  "+PROGRAM"  >; 
call_list  =  0; 

) 


block_data_statement : 

RW  BLOCK  DATA  block  data  identifier 


block_data_identi f ier: 

IDENTIFIER 

{ 

block_name  «  51; 

block  type  =  duplicate!  "+BLOCK_DATA”  i; 
call_Tist  *  0; 

1 


funct ion_statement : 

RW_FUNCTION  f unct ion_ident i f ie r  opt iona l_f orma l_argument_l i st 
I 

type  RW_FUNCTION  funct  i on_ident.  i  f  ie r  opt l onal_£ormal_argument_l i st 
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function_identi f ier : 

IDENTIFIER 

( 

block_name  =  $1; 

block_type  =  duplicate)  "+FUNCTTON"  ); 
call_list  =  0; 

) 


subroutine  statement: 

RWjSUBROUTINE  subrout ine_ident if ier 
I 

RW_SUBROUTINE  subroutine_identif ier  opt ional_formal_argument_list 


subrout i ne_i dent if ier : 

IDENTIFIER 

{ 

block_name  =  SI; 

block_type  =  duplicate)  ■•+SUBROUTINE'*  ); 
call_list  =  0; 

} 


entry_statement : 

RW_ENTRY  entry_identifier 

I 

RW_ENTRY  entry_identifier  optional_formal_argument_list 


entry_identifier : 

IDENTIFIER 


optional_formal_argument  list: 

I 

'('  formal_argumer,t_list  ')' 


formal_argument_list : 

formal_argument 

I 

formal_argument_list  formal_argument 


f ormal_argument : 

IDENTIFIER 

I 

formal_argument_alternate_return 


formal_argument_alternate_return : 
*  *  * 


end_statement : 

RW_END 

( 

add_list(  Sblock_list,  block_name,  block_type,  call_list  ); 

1 


sped  f ication_statement : 

external_statement 

I 

intrinsic  statement 
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parameter_statement 

I 

dimension_statement 

I 

declaration  statement 

I 

save_statement 

I 

common_statement 

I 

equivalence_statement 

I 

implicit_statement 

I 

data_statement 

I 

namelist  sf»tement 


external_statement : 

RW  EXTERNAL  external  list 


external_list : 

external 

I 

external  list  external 


external : 

IDENTIFIER 


intrinsic_statement : 

RW  INTRINSIC  intrinsic  list 


intrinsic_list : 

intrinsic 

I 

intrinsic  list  intrinsic 


intrinsic: 

IDENTIFIER 


parameter_statement : 

RW_PARAMETER  '('  parameter_list  ')' 


parameter_l i st : 

parameter 

I 

parameter_list  1 , '  parameter 


parameter : 

IDENTIFIER  •«'  expression 


dimension_statement : 

RW  DIMENSION  dimension  list 


dimension_list: 

dimens i on 
I 

dimension  list  dimension 
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dimension : 

IDENTIFIER  1  ( ' subscript_list  ')' 


subscript_list : 

subscript 

I 

subscript_list  subscript 


subscript : 

upper_bound 

1 

lower_bound  ' : 1  upper_bound 


lower_bound: 

expression 


uppe r_bound: 

lower_bound 

I 

upper_bound_ad jus table 


upper_bound_ad justable : 
•  *  • 


declaration_statement : 

type  declaration_list 


declaration_list : 

declaration 

I 

declaration  list  declaration 


declaratiou. 

IDENTIFIER  optional  type  length 

I 

IDENTIFIER  '('  subscript  list  ')'  opt ional_type_length 


type: 

type_name  optional_type_length 


type_name : 

RW_CHARACTER 

I 

RW_COMPLEX 

I 

RW_DOUBLE_PREC I S I ON 

I 

RW  INTEGER 
I 

RW  LOGICAL 
I 

RW_REAL 

t 

RW  UNDEFINED 


optional  type_length: 
f *  NULL  */ 
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t 

type_length 


type_length : 

•  *  •  INTEGER 
I 

type_Iength_ad justable 


type_length_ad just able : 
'  f  '*•  ')  1 


save_stacement : 

RW_SAVE  optional_save_list 


optional  save_list: 
r*  NULL  */ 

I 

save  list 


save_list : 

save 

I 

save_list  save 


save : 

IDENTIFIER 

I 

common  name 


common_statement : 

RW_COMMON  optional_common_name  common_list 


optional  common_name: 
P *  NULL  */ 

I 

common  name 


common_name: 

*/'  opt ional_ident if ier  '/' 


optional  identifier: 
/*  NULL  */ 

I 

IDENTIFIER 


common_list : 

common 

t 

comr»on_l  i  st  '  ,  *  common 


jommon : 

IDENTIFIER 


IDENTIFIER  '{'  subscr ipt_l ist  ')' 
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equivalence_statement : 

RW_EQU I VALENCE  equi valence_l i st 


equivalence_list : 

equivalence 

equivalence  list  equivalence 


equivalence: 

' ( '  variable  list  ' ) ' 


variabie_i i st : 

variable 

I 

variable_list  variable 


implicit_statement : 

RW_IMPLICIT  type  ’('  implicit_list  •  >  • 


implicit_list : 

implicit 

I 

implicit_list  implicit 


implicit : 

IDENTIFIER 

I 

IDENTIFIER  IDENTIFIER 


namelist_statement : 

RW  NAMELIST  namelist  name  namelist  list 


namelist_name: 

'/'  IDENTIFIER  '/' 


nanel i st_list : 

namel ist 

I 

namelist_l i st  namelist 


namelist : 

IDENTIFIER 


data_statemcr.t : 

RW  DATA  data  list 


data_list : 

data 

data_list  opt  1 onal _comma  data 


data  : 

data  variable  list  '/'  data  constant  list  '/' 
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data_variable_list : 

data_variable 

data_variable_list  *,*  data_variable 


data_variable: 

variable 

I 

dat a_i mpl ied_do_l i st 


data__impl  ied_do_list : 

'('  data_variable_list  IDENTIFIER  '=■  expression_iisc  ')' 


data_constant_list : 

data_constant 

I 

data_constant_list  data_constant 


data_constant : 

data_initial 1  ration 

IDENTIFIER  data_initialization 

I 

INTEGER  data  initialization 


data_initiali ration : 

IDENTIFIER 

I 

char act er_const ant 

I 

logical  constant 
I 

signed_numerical_constant 


signed_numerical_constant : 

numerica Inconstant 

I 

'+'  numerical_constant  %prec  SIGN 
I 

numerical_constant  %prec  SIGN 


expression: 

parenthesis_expression 

{ 

SS  «  SI; 

) 

I 

simple_expression 

( 

SS  =  Si; 

) 


pa rent he s i s_expressi on : 

■ ( 1  expression  1 ) ' 
( 

SS  *  0; 

) 


simple_expression: 

variable 

( 


SS  -  SI; 
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1 


I 


! 


I 


I 


} 

constant 

( 

$$  =  SI; 

) 

arithmetic_expression 

( 

$$  -  51; 

} 

char acter_express ion 

( 

SS  =  SI; 

} 

relational_expression 

1 

SS  -  SI; 

( 

logical_expression 

{ 

SS  =  SI; 

) 

unary_expression 

( 

SS  =  SI; 

) 


variable : 

IDENTIFIER 

{ 

SS  =  SI; 

) 

I 

IDENTIFIER  string_subset 
( 

SS  «  merge)  "%s%s",  SI,  $2  >; 

) 

I 

array 

{ 

SS  =  SI; 

) 


array: 

IDENTIFIER  '('  opt ional_expressi on_l ist  ')' 

( 

SS  =  array)  SI,  S3  ); 

) 

I 

IDENTIFIER  '('  optional_expression_list  •)'  string  subset 

( 

$$  =  merge)  M%s%s”,  array)  SI,  S3  ),  $5  ); 

) 


optional  expression_l ist : 
A  NULL  */ 

( 

SS  =  0; 

} 

I 

expression  list 

( 

SS  =  SI; 

> 


expression_Iist: 

express i on 
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SS  =  merge)  SI  ); 

1 

expression_list  1  expression 

< 

SS  -  me rge (  -%s(%s)",  SI,  S3  ); 

> 


string_subset : 

optional_expression  optional_expression 

( 

SS  =  merge (  "(*s:%s)“,  S2,  S4  ); 

) 


optional  expression: 
r*  NULL  */ 

( 

SS  -  0; 

1 

I 

expression 

{ 

SS  =  SI; 

1 


constant : 

character_constant 

{ 

SS  -  SI; 

( 


logical_constant 

( 

SS  -  SI; 

} 

numerical  constant 

{ 

SS  =  SI; 

) 


character_constant : 
HOLLERITH 
( 

SS  =  SI; 
i 
I 

STRING 

( 

SS  =  SI; 

1 


iogical_constant : 

RW_FALSE 

( 

SS  =  duplicate)  ".FALSE.”  ); 

) 

I 

RW_TRUE 

( 

SS  =  duplicate)  ".TRUE.”  ); 

) 


numerical_constant : 

DOUBLE_PRECISION 

) 

SS  =  SI; 

) 
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INTEGER 

( 

SS  =  SI; 

} 

REAL 

{ 

$$  =  SI; 
I 


arithmetic_expression : 

expression  '+'  expression  %prec  '+' 

{ 

SS  «  0; 


expression  expression  %prec 

< 

SS  =  0; 

expression  ' * 1  expression  %prec 

{ 

SS  =  0; 

} 

expression  "/'  expression  %prec  '/’ 

{ 

SS  -  0; 

} 

expression  EXPONENTIATE  expression  %prec  EXPONENTIATE 

{ 

SS  =  0; 

) 


character_expression: 

expression  ' /'  '/'  expression  %prec  CONCATENATE 

I 

SS  =  0; 

) 


relational_expression: 

expression  RW_EQ  expression  %prec  RW_EQ 

( 

SS  =  0; 


expression  RW_NE  expression  %prec  RW_NE 

( 

SS  =  0; 
t 

expression  RW_LT  expression  %prec  RW_LT 
f 

SS  =  0; 

) 

expression  RW_LE  expression  %prec  RW_LE 

( 

SS  =  0; 

I 

expression  RW_GT  expression  %prec  RW_GT 
f 

SS  =  0; 

( 

expression  RW_GE  expression  %prec  RW_GE 

f 

SS  =  0; 

} 
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logical_expression : 

expression  RW_AND  expression  %prec  RW_AND 

( 

$S  =  0; 

) 

i 

expression  RW_OR  expression  %prec  RW_OR 

{ 

$$  =  0; 

) 

I 

expression  RW_EQV  expression  %prec  RW_£QV 

( 

SS  =  0; 

} 

expression  RW_NEQV  expression  %prec  RW_NEQV 

( 

$$  =  0; 

) 


unary_expression : 

1 +'  exoression  %prec  SIGN 

{ 

$$  =*  merge)  "  +  %s'\  S2  ); 

1 

I 

expression  tprec  SIGN 

( 

S$  =  merge)  "-%s",  $2  ); 

1 

RW_NOT  expression  %prec  RW_NOT 

1 

$$  *  merge)  ".NOT.%s“,  $2  ); 

1 


executable_statement : 

dojs tatement 
I 

logical_i f_statement 
I 

block_if_statement 

I 

else_statement 

I 

else_if_s tatement 
I 

end_i f_statement 

I 

subset  executable  statement 


do_statement : 

RW_DO  INTEGER  IDENTIFIER  expression_list 


logical_i f _statement : 

i f_expression  subset _executable_statement 


i f_expression : 

RW_IF  '('  expression  ')' 


block_i f_statement : 

RW_TF  '('  expression  ')'  RW_THEN 


else_statement : 

RW  ELSE 


16.  Appendix  K:  network  program  source 


357 


else_i f_statement : 

RW_£LSE_IF  '(•  expression  •)'  RW_THEN 


end_if_statement : 

RW  END  IF 


subset_executable_statement : 

assignment_statement 

I 

assign_statement 

I 

arithmet ic_i f_statement 
I 

continue_statement 

I 

call_statement 

I 

return_statement 

I 

unconditional_go_to_statement 

I 

computed_go_to_statement 

I 

assigned  go_to_statement 
I 

stop_statement 

I 

pause_statement 

I 

io  statement 


assignment_statement : 

variable  •='  expression 


assign_statement : 

RW  ASSIGN  INTEGER  RW  TO  IDENTIFIER 


ari thmet ic_i f_statement : 

RW_IF  '('  expression  integer_list 


continue_statement : 

RW  CONTINUE 


call_statement : 

RW_CALL  IDENTIFIER 

{ 

add_list(  &call_list,  $2,  C,  0  ); 

> 

I 

RW_CALL  IDENTIFIER  optional_actual_argument_iist 

1 

if  (  (  strncmpf  $2,  "SEND_",  5  )  ==  0  ) 

I  I  (  strncmp (  $2,  "RECEIVE_",  8  )  ==  0  )  ) 
addlistf  Scall_list,  S2,  S3,  0  ); 

else 

add_list(  scall_list,  S2,  0,  0  ); 

) 


optional_actual_argument_list : 

'  ( 1  1  )  ' 

( 

SS  =  0; 
i 
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'  ('  actual_argument_list  ')' 

1 

$$  -  $2; 

) 


actual_a rgument_list : 

actual_argument 

( 

$$  =  SI; 

) 

I 

actual_argument_list  ' , '  actualargument 

( 

$$  =  0; 

1 


actual_argument : 

expression 

1 

SS  =  SI; 

1 

I 

actual_argument_alternate_return 

{ 

SS  -  0; 

1 


actual_argument_alternate_return: 
'*•  INTEGER 


return_statement : 

RW_RETURN  optional_expression 


uncondit ional_go_to_statement : 
RW  GO  TO  INTEGER 


computed_go_to_statement : 

RW_GO_TO  integer_list  • ) •  optional_comma  expression 


assigned_go_to_statement : 

RW_GO_TO  IDENTIFIER 

I 

RW_GO_TO  IDENTIFIER  opt ional_comma  '('  integer_list  ')' 


optional  comma: 

r*  NULL  */ 

I 


integer_list : 

TNTEGER 

I 

integer_list  INTEGER 


pause_statement : 

RW_PAUSE  opt i onal_exp ressi on 


stop_statement : 
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RW_STOP  optional_expression 


io_statement : 

open_statement 

I 

close_statement 

I 

inquire_st a cement 
I 

read_statement 

I 

write_statement 

I 

print_statement 

I 

backspace_stacement 

I 

rewind_statement 

I 

endfile  statement 


open_statement : 

RW_OPEN  ' ('  control  information  list  •)' 


close_statement : 

RW_CLOSE  '('  control  information  list  ')' 


inquire_statement : 

RW_INQUIRE  '('  control  information  list  ')' 


statement : 

RW_READ  '('  control_information_list  ')'  optional_io_list 

RWREAD  control 

RW_READ  control  io  list 


write_statement : 

RW_WRITE  '('  control_information_list  ')'  optional_io_list 


print_stat  -lent : 

RW_?RINT  control 

I 

RW_PRINT  control  io_list 


backspace_statement : 

RW_BACKSPACE  '('  control_information_list  ')' 

I 

RW  BACKSPACE  control 


rewind_statement : 

RW_REWIND 

I 

RW  REWIND 


end  f i le_statement : 

RW_ENDFILE  1 ('  cont rol _in forma t ion_l i st  ') ' 


'('  cont rol_i n forma t ion_l i st  ')• 
cont  rol 


read_ 

I 
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cent rol_in format ion_li st : 

control_in format  ion 
I 

control_information_list  control_information 


control_information: 

control 

I 

IDENTIFIER  expression 


control : 

variable 

constant 

I 

<  *  • 


optional  io_list: 

r*  NULL  */ 
I 

io  list 


io_list : 

io 

I 

io_list  1 ,  '  io 


expression 

io_implied_do_list 


io  implied  do_list: 

'('  io_list  IDENTIFIER  expression_l i st  ')' 


f ormat_statement : 

RW  FORMAT 


%% 


FILE:  network/communicat ion/ include/ 1 ist . h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

♦/ 


#define  LIST  struct  list_type 

LIST 

f 

char  'identifier; 
char  'argument; 

LIST  *call_list; 

LIST  'next; 

J  ; 


extern  LIST  'end_list(  ); 
extern  LIST  'add  list!  ); 
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extern  LIST  *fird_list(  ); 
extern  void  print_list(  ); 
extern  void  delete  list!  ); 


FILE:  network /communication/ library /Make file 


# 

it  Copyright  1991 

#  Georgia  Institute  of  Technology 

$  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


CC  =  cc  -g 
INCLUDE  =  . ./include 
CFLAGS  =  -1$ (INCLUDE) 
LIBRARY  *  library. a 


OBJECTS  »  \ 
array. o  \ 
count. o  \ 
duplicate. o  \ 
hollerith.o  \ 
link_list.o  \ 
list.o  \ 
main.o  \ 
merge. o  \ 
non_blank.o  \ 
parse. o  \ 
summary. o  \ 
uppercase. o  \ 
yyerror.o  \ 
yygetc.o  \ 
yywrap. o 


S (LIBRARY) : $ (OBJECTS) 

ar  crv  S (LIBRARY)  S (OBJECTS) 
ranlib  $ (LIBRARY) 


•SUFFIXES:  .c  .o 
.  c.  o : 

S(CC)  -c  S  (CFLAGS)  S< 


clean : 

rm  -f  $ (LIBRARY)  $  (OBJECTS) 


FILE :  network/communicat ion/ 1 ibrary /ar ray . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  char  'list(  ); 
extern  char  “merge  (  ); 


char  'array!  identifier,  opt i onal_expression_l i st  ) 

register  char  'identifier; 

register  char  *optional_expression_list; 

( 

if  (  opt ional_expression_l i st  \=  (char  *)0  ) 

return!  merge)  ”%s(ts)",  identifier,  list!  opt ional_express ion_l i st ,  ",  "  )  )  ); 

else 

return!  merge!  "%s(J",  identifier  )  )  ; 

)  /*  array  */ 


FILE:  network/ commun icat i on/library/ count. c 
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/’ 

’  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


int  count{  string,  length,  c  ) 
register  char  ’string; 
register  int  length; 
register  char  c; 

1 

register  int  c_count  =  0; 

while  (  length  '.  =  0  ) 

{ 

if  (  ’string  «»  c  ) 
c_count++; 

string++; 
length — ; 

) 

return!  c  count  ); 

I  /’  count  */~ 


FILE:  netwo rk/communicati on/lib rary /dupl icate . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((Include  <stdlo.h> 
♦include  <string.h> 
♦include  <malloc.h> 


char  ’duplicate!  string  ) 
register  char  ’string; 

1 

register  char  ’temporary  =  (char  ’(NULL; 

if  (  string  !=  (char  *)NULL  ) 

( 

if  (  (  temporary  =  (char  ’Imalloc!  strlen!  string  )  +  1  )  )  !=  (char  *)NULL  ) 

strcpy(  temporary,  string  ); 

else 

fprintf(  stderr,  "ERROR:  duplicate!  %s  )\n’',  string  ); 

) 


return!  temporary  ); 
)  /*  duplicate  »/ 


FILE :  network /communi cat  ion/ libra ry /hoi lerith. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Labr-'atory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 


char  ’hollerith!  string,  delimeter  ) 
register  char  ’string; 
register  char  delimeter; 

( 
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int  hoi lerith_length; 
register  int  string_length  =  0; 

sscanfl  string,  ”%dh",  Shol lerith_length  ); 

string!  string_length++  )  =  delimeter; 
while  (  hoi lerith_length  !  =  0  ) 

{ 

if  (  (  string!  string_length  ]  =  yyinputl  )  )  ==  ' \n‘  ) 
( 

yyunput (  string!  string_length  ]  ); 
break; 

} 

string_length++; 

hollerith_length--; 

) 

string!  string_length->-’-  j  =  ae-imeter; 

3tring[  string_length  ]  =  'Non¬ 
return  (  string  ) ; 

)  /*  hollerith  */ 


FILE :  net work /communication /I ibrary /iink_list .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author;  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <malloc.h> 
♦include  <string.h> 
♦include  “list.h" 


LIST  *end_l 1st (  list  ) 
register  LIST  'list; 

{ 

if  (  list  ! *  (LIST  * ) NULL  ) 

{ 

while  (  list->next  !-  (LIST  *)NULL  ) 
list  =  list->next; 

) 

return (  list  ) ; 

}  /*  end  list  ’/ 


LIST  *add_list(  list,  identifier,  argument,  cail_list  ) 

register  LIST  "list; 

register  char  'identifier; 

register  char  'argument; 

register  LIST  'call  list; 

( 

register  LIST  'temporary  =  (LIST  *)maiIoc(  sizeof (  LIST  )  ); 

temporary->identif ier  =  identifier; 

temporary->argument  =  argument; 

temporary->call_list  -  call_list; 

temporary->next  =  (LIST  *)NULL; 

if  (  'list  «=  (LIST  ' ) NULL  I 
'list  =  temporary; 

else 

end_list(  'list  ) ->next  =  temporary; 

return)  temporary  ); 
f  /*  add  list  '/ 


LIST  'find_list(  list,  identifier  ) 
register  LIST  'list; 
register  char  'identifier; 

; 

while  (  iist  !=  (LIST  '(NULL  ) 
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( 

if  (  strcmp!  list->identif ier,  identifier  )  ==  0  ) 
return (  list  ) ; 

list  =  list->next; 

1 

return (  (LIST  ‘(NULL  ); 

)  /*  find_list  */ 


void  print_list(  file,  list  ) 
register  FILE  ‘file; 
register  LIST  ‘list; 

( 

register  LIST  *call_list; 

while  (  list  !=  (LIST  ‘(NULL  ) 

{ 

fprintf(  file,  ”%s  %s\n",  list->identifier,  list->argument  ); 

call_list  =  list->call_list; 
while  (  call_list  !=  (LIST  *)NULL  ) 

( 

fprintf(  file,  "\t%s",  call_list->identifier  ); 
if  (  call_list->argument  !=  0  ) 

fprintf(  file,  "(  %s  )",  call_list->argument  ); 
fprintfl  file,  "\n"  ); 

call_list  =  call_list->next; 

1 

fprintfl  file,  "\n“  ); 
list  ■  list->next; 

1 

(  /*  print_list  */ 


void  delete_list<  list  ) 
register  LIST  ‘list; 

1 

if  (  list  !=  (LIST  * ) NULL  ) 

{ 

delete_list(  list->next  ) ; 
free (  list  ) ; 

1 

)  /*  delete_list  */ 


FILE :  network/communicat ion/ 1 ibrary / 1 i st . c 


/* 

*  Copyright  1991 

'  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  char  ‘parse (  ); 
extern  char  ‘merge (  ) ; 


char  ‘list!  input_list,  delimeter  ) 
register  char  *input_list; 
register  char  ‘delimeter; 

( 

register  char  *output_l ist; 
register  char  ‘list; 
register  char  ‘temporary; 

output_iist  =  parse!  input  list  ); 
list  =  parse!  input_iist  ); 

while  (  list  !=  (char  *>0  ) 

{ 

temporary  =  merge!  "%s%s%s",  output_list,  delimeter,  list  ); 
free!  output_list  ); 
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free (  list  ) ; 

output_list  =  temporary; 
list  =  parse!  input_list  ); 

} 

return!  output_list  ); 

}  /*  list  */ 


FILE;  network /communication /library /main . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 


extern  FILE  *yyin; 
extern  FILE  ‘yyout; 


♦define  PROGRAM  argument!  0  ] 
♦define  INPUT_FILE  argument!  1  i 
♦define  OUTPUT_FILE  argument!  2  ] 


int  main!  number_argument,  argument  ) 
int  number_argument; 
char  ‘argument!  ); 

( 

if  (  number_argument  ==  1  ) 

( 

yyin  -  stdin; 

yyout  =  stdout; 

yy parse!  ); 

exit  (  0  )  ; 

) 

if  1  number_argument  ==  3  ) 

( 

if  (  (  yyin  =  fopen (  INPUT_FILE,  "r"  )  )  ==  (FILE  *)NULL  ) 

( 

fprintf!  stderr,  "»s:  ERROR  -  unable  to  open  input  file  ' *s'\n",  PROGRAM, 
INPUT_FILE  ) ; 

exit!  -1  >; 

> 

if  (  (  yyout  =  fopen!  CUT? 7T  FILE,  "v"  )  I  «  =  (FILE  * ) NULL  ) 

l 

fprintf!  stderr,  "%s:  ERROR  -  unable  to  open  output  file  ’ ts'Vn",  PROGRAM, 
OUTPUT_FILE  ) ; 

exit!  - 1  ) ; 

) 

yyparse (  ! ; 

exit (  0  ) ; 

) 

fprintf!  stderr,  "usage:  %s  <input  file>  ^output  file>\n",  PROGRAM  I; 
exit (  0  i ; 

)  /  *  main  *  / 


FILE,  network/ common i cat. on/library/ me roe . c 


*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Lac .rat  , rv 

*  Author:  Stephen  R.  Wachte. 

*/ 


/ 
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•include  <stdio.h> 
•include  <string.h> 
((include  <malloc.h> 


•define  STRLEN (  s  )  (  strlenl  s  )  -  2  ) 


char  'merge (  string,  a,  b,  c,  d  ) 
register  char  'string; 
register  char  'a; 
register  char  *b; 
register  char  'c; 
register  char  'd; 

{ 

register  char  'temporary  =  (char  '(NULL; 

switch  (  count (  string,  strlenl  string  ),  '%’  )  ) 

( 

case  0: 

if  (  (  temporary  =  (char  ')malloc(  strlenl  string  )  +  1  )  )  !=  (char 

sprintf(  temporary,  string  ); 

else 

fprintf(  stderr,  "ERROR:  merge!  %s  )\n“,  string  ); 

break; 

case  1: 

if  (  (  temporary  =  (char  ')malloc(  strlenl  string  )  +  STRLEN (  a  )  + 

(char  '(NULL  ) 

sprintfl  temporary,  string,  a  ); 

else 

fprintfl  stderr,  "ERROR:  merge!  %s,  %s  )\n",  string,  a  ); 

break; 

case  2: 

if  (  (  temporary  =  (char  ')malloc(  strlenl  string  )  +  STRLEN (  a  )  + 

)  +  1  )  )  !=  (char  ' ) NULL  ) 

sprintfl  temporary,  string,  a,  b  )  ; 

else 

fprintfl  stderr,  “ERROR:  merge!  %s,  %s,  %s  )\n",  string,  a,  b  ); 

break; 

case  3: 

if  (  (  temporary  =  (char  *)malloc(  strlen(  string  +  STRLEN!  a  )  * 

)  +  STRLEN (  c  )  +  1  )  )  !=  (char  '(NULL  ) 

sprintfl  temporary,  string,  a,  b,  c  ); 

else 

fprintfl  stderr,  "ERROR:  merge!  %s,  %s,  %s,  %s  )\n",  string,  a, 

break; 

case  A: 

if  (  (  temporary  =  (char  *)maiioc(  strlenl  string  )  +  STRLEN (  a  )  ♦ 

)  +  STRLEN (  c  )  +  STRLEN!  d  )  +  1  )  )  !=  (char  "(NULL  ) 
sprintfl  temporary,  string,  a,  b,  c,  d  ); 

else 

fprintfl  stderr,  "ERROR:  merge!  %s,  %s,  %s,  %s,  %s  )\n",  string, 

>  ; 

break; 

default : 

fprintfl  stderr,  "ERROR:  merge!  %s  )\n",  string  i; 

break; 

) 

return!  temporary  ); 
i  /'  merge  '/ 


FILE:  net wo  rk /commun icari on /libra  ry /non_bl ank . c 


/* 

'  Copyright  1991 

'  Georgia  Institute  of  Technology 
*  Computer  Engineering  Research  Lacoratcry 
'  Author:  S"epnen  R.  Wachtei 

'/ 


'(NULL  j 


1  )  )  !  = 


STRLF.N  (  o 


STRLEN  (  b 


d,  c  )  ; 


STRLEN  (  o 


a,  b,  c,  d 


•include  <string.h> 
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char  *non_blank(  string  ) 
register  char  ‘string; 

{ 


register  int  offset; 
register  int  length; 


length  =  strlen!  string  )  -  1; 
while  (  (  string!  length  )  ==  '  ' 

)  && 

(  string! 

length  ] 

!  =  'NO' 

string!  length —  ]  =  ' \0'; 

offset  =  0; 

while  (  (  string!  offset  ]  ==  '  ■ 

)  && 

(  string! 

offset  ] 

!=  1  \0  ' 

string!  offset**  ]  =  'NO'; 

strcpy!  string,  Sstring!  offset  ] 

if  (  strlen!  string  )  !=  0  ) 

) ; 

return  (  string  ); 
else 

return (  0  ) ; 

}  /*  non  blank  */ 


FILE :  network /communication/ 1 ibrary /parse . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
•/ 


((include  <string.h> 
extern  char  ‘duplicate!  ); 


char  ‘parse!  list  ) 
register  char  ‘list; 
f 

register  int  length  =  0; 

register  int  brace  =  0; 

register  char  ‘temporary  =  (char  *)0; 

for  (;;> 

{ 

switch  (  list[  length  1  ) 

( 

case  ' (  '  : 

brace**; 

break; 

case  ' ) ' : 

brace-- ; 
break; 

) 

if  !  brace  ==  0  ) 
break; 

length*  +  ; 

i 

i f  (  length  ! =  0  i 
I 

list!  length  |  =  • \0 ' ; 

temporary  »  duplicate!  list  ♦  1  ); 

strcpy!  list,  list  *  1  +  length  ); 

f 

else 

! 

if  (  list!  length  ;  !=  1 \0*  ) 

temporary  =  duplicate!  list  ); 
list!  length  j  =  1 \0 ' ; 
i 
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1 

return!  temporary  ); 
)  /*  parse  */ 


FILE:  network/communicat ion/ library /summary . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
■/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  "list.h" 


extern  FILE  *yyin; 
extern  FILE  ‘yyout; 


♦ifdef  DEBUG 

void  print_level (  level  ) 
register  int  level; 

< 

while  (  level —  !=  0  ) 

fprintf  (  yyout,  '•it"  ); 
}  /*  print_level  */ 


void  print_trace(  block_^list,  identifier,  argument,  level  ) 

register  LIST  *block_list; 

register  char  ‘identifier; 

register  char  ‘argument; 

register  int  level; 

1 

LIST  ‘list; 

LIST  *call_list; 

print_level (  level  )  ; 

fprintf (  yyout,  "%s",  identifier  ); 

if  (  argument  ! =  (char  * ) NULL  ) 

fprintf (  yyout,  "  (  %s  argument  ); 

fprintf!  yyout,  "\n"  )  ; 

if  (  (  list  =  find_list(  block_list,  identifier  )  )  ==  (LIST*)NULL  ) 
return; 

if  (  *list->argument  ==  '+'  ) 

{ 

*list->argument  - 

call_list  =  1 ist->call_l ist ; 
while  (  cal 1_1 ist  !=  (LIST  *)NULL  ) 

( 

print_trace(  block_list,  cal 1_I i st ->ident i f ier,  call  1 i st ->argument , 

)  ; 


call_list  =  call_list->next; 

) 

*li3t->argument  - 

) 

)  /*  print_trace  */ 

♦  e  1  se 

void  print_trace(  block_list,  identifier,  argument,  level  ) 

register  LIST  *block_list; 

register  char  ‘identifier; 

register  char  ‘argument; 

register  int  level; 

{ 

LIST  ‘list; 

LIST  * ca 1 1_1 i st ; 

if  (  strncmp!  identifier,  "SEND  ",  Si  -=  C  ) 


level  * 
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( 

fprintff  yyout,  "%s  %s  S\n",  argument,  sidentifier!  5  ]  ); 

return; 

l 

if  (  strncmpt  identifier,  ,,RECEIVE_,‘,  8  )  ==  0  ) 

{ 

fprintff  yyout,  "%s  fcs  R\n",  argument,  Sidentifier!  8)); 
return; 

) 

if  (  (  list  =  find_list(  block_list,  identifier  )  )  ==  (LIST  *)NULL  ) 
return; 

if  (  *list->argument  ==  '+'  ) 

( 

‘list->argument  = 

call_list  =  list->call_list; 
while  (  call_list  !=  (LIST  ‘(NULL  ) 

( 

print_trace(  block_list,  call_list->identif ier,  call_list->argument, 

)  ; 

call_list  =  call_list->next; 

) 

*list->argument  =  ' +'; 

) 

1  /*  print_trace  */ 

(tendif 


void  summary!  list  ) 
register  LIST  'list; 

{ 

while  (  list  !=  (LIST  *)NULL  ) 

( 

if  (  strcmp(  list->argument,  "^PROGRAM"  )  ==  0  ) 
print_trace(  list,  list->identifier,  0,  0  ); 

list  =  list->next; 

) 

)  /*  summary  */ 


FILE :  networ k/communi cat  ion/ 1 ibrary /uppercase . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


char  ‘uppercase (  string  ) 
register  char  ‘string; 

( 

register  int  index  =  0; 

while  (  string!  index  )  !=  '\0'  ) 

( 

string!  index  ]  =  toupper(  string!  index  1  ); 

index++; 

l 

return (  string  ) ; 

(  /*  uppercase  */ 


FILE:  network/ commun i cation/library/yyerror.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laooratcry 

*  Author:  Stephen  R.  Wachtel 

*/ 


level  +  I 
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((include  <stdio.h> 


extern  int  yylineno; 


void  yyerror!  string  ) 
register  char  ‘string; 

( 

fprintff  stderr,  “line  fcd,  %s\n",  yylineno,  string  ); 

exit (  -1  ) ; 

1  /*  yyerror  */ 


FILE:  network/ conmuni cat i on/ 1 ibra ry /yyge t c. c 


/* 

*  Copyright  1991 

‘  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


((include  <stdio.h> 
♦include  <ctype.h> 


extern  int  yylineno; 


int  tab(  length  ) 
register  int  length; 

( 

while  (  length —  ! =  0  ) 
yy unput (  '  '  ) ; 

return (  '  '  ); 

)  /*  tab  */ 


int  yygetcf  file  ) 
register  FILE  ‘file; 
( 


int 

int 

c; 

column [  6  ] ; 

loop: 

if 

if 

(  (  c  =  getc(  file  )  ) 
c  =  tab (  6  ) ; 

(  c  ! =  ' \n '  ) 
return (  c  ) ; 

==  ’\t' 

) 

if 

(  (  column!  0  1  =  getc( 
goto  abort  0; 

file  ) 

)!='') 

if 

(  (  column!  1  ]  =  getc( 
goto  abort  1; 

file  ) 

)!='•) 

if 

(  (  column!  2  )  =  getc( 
goto  abort_2; 

file  ) 

)’=•■) 

if 

(  (  column!  3  J  =  getc( 
goto  abort  3; 

file  ) 

)!=••) 

if 

(  (  column!  4  ]  =  getc( 
goto  abort  4; 

file  ) 

)!=’■) 

if  (  isspaoe{  column(  5  ] 
goto  abort  5; 

yylineno++; 
goto  loop; 

--  getc( 

file  )  )  ) 

a bort_5 : 

if  (  column f  5  ]  ==  '\t'  ) 
tab!  1  ) ; 

else 

( 

yyunput (  column!  5  |  ); 

if  (  column!  5  I  ==  ‘\n'  ( 
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yyl inenott; 

1 

abort_4 : 

if  (  column!  4  ]  -=  ’\t'  ) 
tab (  2  ) ; 
else 
( 

yyunput (  column!  4  )  ); 
if  (  column!  4  ]  ==  '\n‘  ) 
yylineno++; 

1 

abort_3 : 

if  (  column!  3  1  ==  ' \t 1  ) 
tab (  3  ) ; 

else 

( 

yyunput!  column!  3  ]  ); 
if  (  column!  3  ]  ==  '\n‘  ) 
yylineno++; 

\ 

abort_2 : 

if  (  column!  2  J  =■=  '\t'  ) 
tab (  4  ) ; 
else 
! 

yyunput!  column!  2  1  ); 
if  (  column!  2  ]  ==  '\n'  ) 
yylineno++; 

) 

abort_l : 

if  (  column!  X  1  ==  '\t'  ) 
tab (  5  ) ; 
else 
f 

yyunput!  column!  1  ]  ); 

if  (  column!  1  i  mm  *\n'  ) 
yylineno++; 

( 

abort_0 : 

if  (  column!  0  ]  <■»  *\t'  ) 
tab  <  6  ) ; 

else 

( 

yyunput!  column!  0  ]  ); 
if  (  column!  0  )  ==  ' \n'  ) 
yylineno++; 

1 


return (  c  ) ; 
}  /*  yygetc  */ 


FILE:  net work/ communi cat  ion/ libra ry /yyw rap . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  cf  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


int  yywrap!  ) 

f 

return (  1  ) ; 
)  /*  yywrap  */ 


FILE :  network/communica t i on/scan ner.l 


%( 

/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 
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*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 

%) 


%a  10000 
%e  10000 
»k  10000 
%n  10000 
%o  10000 

%p  10000 


a  [aA] 
b  [bB] 
c  [cCl 
d  [dD  1 
e  [eE] 
f  [fFl 
g  [gGl 
h  [hH  1 
i  till 
j  IjJl 
k  [kKl 
1  UL) 
m  [mMl 
n  rnN] 
o  [oO] 
P  CpPl 
q  [qQ! 
r  [rRl 
s  [sS] 
t  C  t  T  ] 
u  [uU] 
v  [vV] 
w  [wW] 
X  [xX] 

y  [yvi 

z  ( zZ  1 


%{ 

#include  "grammar. h" 
extern  char  *yylval; 


#undef  YYLMAX 
idefine  YYLMAX  (256*20) 


extern  char 
extern  char 
extern  char 
extern  char 

») 


•duplicate!  ) 
*hollerith(  ) 
*non_blank  (  ) 
•uppercase!  ) 


%% 


* [\*cC] .* !\n]  I 
A(\  )*[\n]  ( 

#i fdef  DEBOG 
ECHO; 

Itendi  f 

yylval  =  duplicate!  yytext  ); 
return!  COMMENT  ); 

I 


\  I  ( 

#ifdef  DEBUG 
ECHO; 

#endi f 

/*  return!  '\  '  )  */; 

) 


[\*1  ( 

I i fdef  DEBUG 
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ECHO; 

#endi  f 

return (  ' \S '  ) ; 

} 


[\<]  < 

Kifdef  DEBUG 
ECHO; 

#endif 

return  (  •  \  ( ■  )  ; 

> 


(\)  1  { 
ftifdef  DEBUG 
ECHO; 
iendi f 

return  (  '  \ )  '  )  ; 

) 


[\*1  ( 
ftifdef  DEBUG 
ECHO; 

#endi f 

return (  ’ \* '  ) ; 

) 


[\*)[\*1  { 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  EXPONENTIATE  ); 

1 


[ \+  1  ( 

# i f def  DEBUG 
ECHO; 

#endi f 

return!  • \+'  ); 

1 


[\,  1  ( 

#ifdef  DEBUG 
ECHO; 

#endi  f 

return (  ' '  ) ; 

1 


[\-l  { 

# i fde  f  DEBUG 
ECHO; 

#endi f 

return  (  • \  •  ) ; 

1 


[\.  1  { 

# i fdef  DEBUG 
ECHO; 

#endi f 

return  (  '  \  '  )  ; 

) 


[\/i  ( 

#iidef  DEBUG 
ECHO; 

(tend  i  f 

return  (  '  \ /  '  ) ; 

I 


[Nil  f 

I i fdef  DEBUG 
ECHO; 
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(tendi  f 

return (  ' \ '  ) ; 

1 


[\=1  ( 

(t i fdef  DEBUG 
ECHO; 

#endif 

return (  1 \= '  )  ; 

) 


[\n]  ( 

(tifdef  DEBUG 
ECHO; 

(tendi  f 

/*  return (  ■  \n‘  )  */; 

1 


[\t]  { 

(tifdef  DEBUG 
ECHO; 

(tendi  f 

/*  return!  ‘ \t'  )  */; 

1 


[\.)  Ul(n)idH\.l  ( 

# i fdef  DEBUG 
ECHO; 

(tendi  f 

return!  RW_AND  ); 

1 


[\.J (e)(ql [\.l  ( 

♦i fdef  DEBUG 
ECHO; 

(tendi  f 

return (  RW  EQ  ) ; 

1 


t\. lle)lq)|v> [\. ]  ( 

(t  i  fdef  DEBUG 
ECHO; 

#endi f 

return!  RW_EQV  ); 

) 


[\.]{f)fa)(l}(s)(e)[\.l  ( 

(tifdef  DEBUG 
ECHO; 

#endi  f 

return!  RW_FALSE  ); 

1 


(\.) (g)(e) [\.l  ( 

# i f de  f  DEBUG 
ECHO; 

#endi f 

return (  RW_GE  ) ; 

) 


[ \ -  1  Iql(t)  [ \ .  )  ( 

(tifdef  DEBUG 
ECHO; 

Itendi  f 

return!  RW_GT  ); 

) 


f\. 1 llllel  f\. 1  ( 
(tifdef  DEBUG 
ECHO; 
lendi f 
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return (  RW_LE  ); 

( 


[\.](lHt}[\.)  ( 
lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_LT  ) ; 

} 


[\.]<n){e>[\.]  ( 

#ifdef  DEBUG 
ECHO; 
lendi f 

return!  RW_NE  ); 

) 


[\.  )  { n }  (eHql(v)  [\.  ]  { 

lifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_NEQV  ) ; 

) 


[\.lln){o](tl[\.]  ( 

lifdef  DEBUG 
ECHO; 
lendi  f 

return (  RW_NOT  ) ; 


[\. )  (oHrl  [\.  1  ( 
ftifdef  DEBUG 
ECHO; 

#endi f 

return)  RW_OR  ); 

( 


[\.Ht||rKuHe)[\.]  ( 

iifdef  DEBUG 
ECHO; 

#endi f 

return!  RW_TRUE  ); 

1 


(  a)  (  s}  {  s)  {  i  Hq|  (  n»  ( 

#i fdef  DEBUG 
ECHO; 

Kendi f 

return!  RW_ASSIGN  ); 

) 


(b]|a)(c|(k)|sHpMa)|c)|e|  { 

Hi fdef  DEBUG 
ECHO; 
lendi f 

return!  RW_BACKSPACE  ); 

) 


(b)  (1  Mol  (c)  (kH\  ]*|dllal|t)Ul  { 
Kifdef  DEBUG 
ECHO; 

(tendi  f 

return!  RW  BLOCK  DATA  ); 


(c)laHlKl)  ! 

Iifdef  DEBUG 
ECHO; 
lendi f 

return!  RW  CALL  )  ; 
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1 


(cllh|(a|(rl(4|(c|(t||e|(r|  { 

#i fdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_C H  ARAC TER  ) ; 

) 


(c)UHoHsHe)  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_CLOSE  ); 

) 


(c) (o) (m) (m) {o} (n)  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_COMMON  ) ; 

) 


le)(o)(mHp)(l)(e)(x)  ( 

lifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_COMPLEX  ); 

) 


(c)(oHn)(tHlHnMu||e)  { 
#ifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_CONTINUE  ); 

} 


(d)(a((t)la)  { 

#ifdef  DEBUG 
ECHO; 

Kendif 

return  (  RW_DATA  ); 

i 


(dMi)(ir>|{e)(n!(s)(i)(o)(n)  ( 

Hi fdef  DEBUG 
ECHO; 

*endi f 

return  (  RW  DIMENSION  ); 


(d)(0)  { 

Hi fdef  DEBUG 
ECHO; 

#endi f 

return (  RW_DO  ) ; 

) 


f  d )  ( o)  { u>  (b)  { 1 )  (e)  [  \  )*lpHr)(e)|c|U)[s)(i)|o)(n|  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_DOUBLE_PRECISION  ); 

) 


(e)flHsKe) 

It  i  fdef  DEBUG 
ECHO; 
lendi  f 

) 


return!  RW  ELSE  ); 


16.  Appendix  K:  network  program  source 


377 


le)U){s|(el[\  1  *  ( i  1  ( f  1  { 

(tifdef  DEBUG 
ECHO; 

#endi  f 

return (  RW_ELSE_IF  ); 

} 


(e}{n)(d)  { 

#ifde£  DEBUG 
ECHO; 

#endi f 

return (  RW_END  ) ; 

} 


lel(nKd)  [\  ]*(!>{£}  ( 

(tifdef  DEBUG 
ECHO; 

(tendi f 

return!  RW_F.ND_IF  ); 

} 


(eHnHd)|£Hiimie)  { 

#i£def  DEBUG 
ECHO; 

#endi f 

return!  RW_ENDFILE  ); 

1 


(e)  (n>  (tKr)(y)  ( 

(tifdef  DEBUG 
ECHO; 

(tendi  f 

return  (  kW_ENTRY  ) ; 

) 


(e((ql(ui(i)(v}(a)(l>(e)(n)(c}(e)  ( 
#i fdef  DEBUG 
ECHO; 

Itendi  f 

return!  RW_EQU I VALENCE  ); 

( 


leHxlltlleHrUnHaHU  ( 
(tifdef  DEBUG 
ECHO; 

Itendi  f 

return (  RW_EXTERNAL  ) ; 

} 


|f|(ol(r|(«]|a|(t|.'  { 

(tifdef  DEBUG 
ECHO; 

Itendi  f 

yylval  =  duplicate!  yytext  ); 
return!  RW_FORMAT  ); 

) 


(f((u)!n)(c>(t)(i)|o>(n)  ( 

Itifdef  DEBUG 
ECHO; 

Itendi  f 

return!  RW_FUNCTION  ); 

) 


(ql(o![\  I'ltHo)  ( 

Itifdef  DEBUC 
ECHO; 

(lendi  f 

return!  RW_GO_TO  ); 

i 


378 


Annual  Report:  Digital  Emulation  Technology  Laboratory  Volume  1,  Part  2 


lil(f)  ( 

#ifdef  DEBUG 
ECHO; 

Itendif 

return (  RW_IF  ); 

) 


{iHmUplflHi)  fc)(i)tt)  f 
# i f de  f  DEBUG 
ECHO; 

Itendi f 

return!  RW_IMPLICIT  ); 

1 


|iHnHc)(l>|u}|d}{e}  f 
It  if  def  DEBUG 
ECHO; 

Itendif 

return  (  RW_INCLUDE  ) ; 

} 


(lllnl  (q)  {ul  (illrUe)  { 

# i f def  DEBUG 
ECHO; 

Itendi  f 

return!  RW_INQUIRE  ); 

1 


lillnlft)  letlglleHrl  { 

It  if  def  DEBUG 
ECHO; 

#endi f 

return!  RW_INTEGER  ); 

1 


I  i  >  In) Itllr) |i) (nl|slli||c|  I 
It  if  def  DEBUC 
ECHO; 

Itendi  f 

return!  RW_INTRINSIC  ); 

) 


{ 1) (o) fg> (i> |c) (a) ( H  ( 

#i fdef  DEBUG 
ECHO; 
lendi f 

return!  RW_LOGICAL  ); 

} 


<n)(ai(m)(e)(l)!il(s)(tl  f 
# i f de  f  DEBUG 
ECHO; 

#endi f 

return (  RW_NAMELIST  ) ; 

1 


(oHp)leHn)  I 
# i f de  f  DEBUG 
ECHO; 
ter.di  f 

return!  RW  OPEN  >; 

) 


( p )  ( a  1  (  r  II  a )  I  m  1  !  e )  ( t  i  ( e  (  i  r  i  1 
Ilfdef  DEBUG 
ECHO; 

Itendi  f 

return!  RW_PARAMETER  ); 

1 
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(pHa)l'Jl(sMe!  ! 
iifdef  DEBUG 
ECHO; 
iendi  f 

return!  RW_PAUSE  ); 

1 


IpHrlUHnHtl  ( 
i i fdef  DEBUG 
ECHO; 
iendif 

return!  RH_PRINT  ); 

} 


iPitrHoUgKrliailai}  { 
iifdef  DEBUG 
ECHO; 
iendi f 

return  (  RW_PROGRAM  ) ; 

) 


(r}(e)[a)(d)  ( 

iifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW^READ  } ; 

} 


{ r> (e> (a) (1>  ( 

#ifdef  DEBUG 
ECHO; 
iendi f 

return (  RW_REAL  ) ; 

I 


|r||e|(tl{uHrHn|  { 
i i fdef  DEBUG 
ECHO; 
iendif 

return!  RW_RETURN  ); 

) 


(r)(e)fw}(i)(n)(d}  ( 
i i fdef  DEBUG 
ECHO; 
iendi f 

return!  RW_REWIND  ); 

) 


{ s  > (al (v) (e)  { 

iifdef  DEBUG 
ECHO; 
iendi f 

return (  RW_SAVE  ) ; 

) 


(sMtMoMp)  f 
iifdef  DEBUG 
ECHO; 
iendi  f 

return  I  RW_STOP  ) ; 

) 


(sHuHb||r)(o||uHtMiHn({el  { 
iifdef  DEBUG 
ECHO; 
iendif 

return!  RW  SUBROUTINE  ); 

) 
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UllhHelfnl  t 
tifcef  DEBUG 
ECHO; 
fendi  £ 

return!  RW_THEN  ) ; 

) 


tifdef  DEBUG 
ECHO; 

#endi f 

return (  RW_T0  ) ; 

1 


t w  ]  (  r !  t  i  }  { t  (  ( e )  { 

tifdef  DEBUG 
ECHO; 
tendif 

return (  RW_WRITE  ) ; 

1 


( u  >  !  n  M  d  1  ( e }  (  f }  (  i  >  ( n )  [  e { d )  ( 

#ifdef  DEBUG 
ECHO; 
if**ndi  f 

return (  RW_UNDEFINED  ); 

) 


f%a-zA-Z] f_a-zA-Z0-9! *  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

yylval  =  duplicate;  uppercase!  yytext  )  ); 
return!  IDENTIFIER  ); 


-(0-9  ]  [0-9  )  [0-9  ]  [0-9  3  [0-9  J  f\  )  ! 

#ifdef  DEBUG 
ECHO; 
ftendi  £ 

yylval  =  duplicate!  non_blank(  yytext  )  ); 
return!  LABEL  ); 


[0-9]+  | 

[0-9J  +/\ . [a-zA-Z|  +  \.  { 

#i+def  DEBUG 
ECHO; 

(tendif 

yylval  =  duplicate!  yytext  ); 
return!  INTEGER  ); 


[ 0-9 ) +\ . [0-9] * ( [eEJ  [ \  +  \  - ] ?[0-9]+)  ? 
[0-9] *\. [0-9]+ ( [eE] (\+\-! ?[0-9]+) ? 
[0-9]  +  (  [eE]  [\  +  \-]  ?  [ 0- 9 ]  +)  ?  ( 
tifdef  DEBUG 
ECHO; 
tendi f 

yylval  =  duplicate!  yytext  ); 
return!  REAL  ); 


[0-9]  +\.  [0-9]  *  (  [dD]  [ \  +  \  —  ]  ?  [0-9]  +  )  ?  1 

[0-9] *\. [0-9J  +  ( [dD]  C \  +  V- I ? [ 0-9 ] +) ?  I 
[0-9]  +  ( [dD]  [\  +  \-] ? [0-9] +) ?  ( 
tifdef  DEBUG 
ECHO; 
tendif 

yylval  -  duplicate!  yytext  ); 
return!  DOUBLE_PRECISICN  ); 

1 
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\  '  f'\ '  1  *\ •  I 
\"[~\”]*V  { 

#ifdef  DEBUG 
ECHO; 

♦  endi  f 

yytext [  0  ]  =  •  \ "  1  ; 

yytext [  strlenl  yytext  )  -  1  ]  =  ‘ \ 
yylval  -  duplicate)  yytext  ); 
return)  STRING  ); 

1 


[0-9]  +  [hH]  ( 

#i fdef  DEBUG 
ECHO; 
rfendi  f 

yylval  =  duplicate)  Hollerith)  yytext 
return)  HOLLERITH  ); 

) 


FILE:  netwcrk/network/Makefiie 


# 

»  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Compliter  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


default:  network 


CC  =  cc  -g 
INCLUDE  =  include 
CFLAGS  =  -IS (INCLUDE) 
LIBRARf  =  1 ibrary/library . a 


network. o:  network. c 

$(CC)  S  (CFLAGS)  -c  network. c 


network:  network. o  S (LIBRARY) 

$ (CC)  $ (CFLAGS)  -o  network  network. o  S (L 


clean : 

cd  library;  make  clean 
rm  -f  network  network. o 


FILE:  network /network/ include/ list .h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


Idefine  LIST  struct  list_type 
LIST 
< 

char  ‘identifier; 
char  messagetype; 
char  usage; 
int  priority; 

LIST  ‘next; 

)  ; 


extern  LIST  *end_list(  ); 
extern  LIST  *add_iist(  ); 
extern  LIST  *fi.nd_list(  ! 
extern  'r- ;  -~J-r  l  ;  -  ,  ' 


)  )  ; 


BRARY) 
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extern  void  delete_list(  >; 

FILE :  network /network/ include /processor . h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


Idefine  NUMBER  PROCESSOR  32 


(♦define  PROCESSOR  struct  processor_type 
PROCESSOR 
( 

char  *file_name; 
int  s; 
int  r; 

LIST  ‘list; 

char  usage [  NUMBER_PROCESSOR  +  11; 

)  ; 


extern  PROCESSOR  processor!  NUMBER_PROCESSOR  ]; 


FILE :  network /network/ library /Makef i le 


# 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

l  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


CC  »  cc  -g 
INCLUDE  =  ../include 
CFLAGS  =  -1$ (INCLUDE) 
LIBRARY  -  library. a 


OBJECTS  =  \ 
count. o  \ 
duplicate. o  \ 
link_list.o  \ 
message_type_length . o  \ 
message_type_name . o 


S (LIBRARY) : S (OBJECTS) 

ar  crv  S (LIBRARY)  S (OBJECTS) 
ranlib  S (LIBRARY) 


-SUFFIXES:  .c  .o 
.  c.  o : 

$(CC)  -c  $ (CFLAGS)  S< 


clean : 

-f  S  (LIBRARY)  S  (OBJECTS) 


FILE:  ne t work /net wo rk/ I ibrary/ count. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Eng!  nt-ei.1.  j  L 

*  Author:  Stephen  R.  Wachtel 

*/ 
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int  count  (  string,  length,  c  ) 
register  char  "string; 
register  inc  length; 
register  char  c; 

{ 

-»5i:*2r  int  c_count  =  0; 

while  (  length  !=  0  ) 

{ 

if  (  "string  ==  c  ) 
c_count++; 

string++; 

length--; 

t 

return (  c_count  ); 

}  /*  count  */ 


FILE :  network/network /library /duplicate . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

’  Computer  Engineering  Research  Laboratory 

*  Author;  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 

♦  include  <scnng.h> 
♦include  <malloc.h> 


char  "auplicatel  string  ) 
register  char  "string; 

{ 

register  char  "temporary  =  (char  * ) NULL; 

if  (  string  !=  (char  *)NULL  ) 

( 

if  (  (  temporary  -  (char  ")malloc(  strlenf  string  )  +  1  )  )  !=  (char 

strcpy(  temporary,  string  ); 

else 

fprintf(  stderr,  "ERROR;  duplicate)  %s  )\n",  string  ); 

1 

return)  temporary  ); 

)  /*  duplicate  */ 


FILE ;  network /net work/ 1 ibrary /I ink_l i st . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  <malloc.h> 
♦include  "list.h" 


extern  char  "duolicatcl  ! ; 


LIST  *end_list (  .ist  ) 
register  LIST  *l_st; 

if  (  list  ! -  (LIST  * ) NULL  ) 

( 

while  (  li st->next  (=  (LIST  *)NULL  ) 
list  =  list->next; 


"  )  NULL  ) 
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1 

return  (  list  ) ; 
t  /*  end  list  */ 


LIST  "add_list(  list,  identifier,  message_type,  usage,  priority  ) 

register  LIST  ""list; 

register  char  -identifier; 

register  char  *message_type; 

register  char  usage; 

register  int  priority; 

{ 

register  LIST  "temporary  =  (LIST  *)malioc(  sizeofl  LIST  )  ); 

temporary-sider.tifie’-  =  duplicate!  identifier  ); 

temporary->message_type  =  duplicate!  message_type  ); 

temporary->usage  =  usage; 

temporary->priority  =  priority; 

temporary->next  =  (LIST  ")NULL; 

if  (  "list  ==  (LIST  * ) NULL  ) 

•list  =  temporary; 

else 

end  list(  ‘list  ) ->next  =  temporary; 

return  (  temporary  ); 

)  /*  add  list  •/ 


LIST  *find_list(  list,  identifier,  message_type  ) 
register  LIST  'list; 
register  char  *identifier; 
register  char  *message_type; 

( 

while  (  list  !=  (LIST  *)N(JLL  ) 

( 

if  (  (  strcmpl  1 i st ->iden t i f ier ,  identifier  )  ==  0  ) 

Si  (  strcmpl  list->message_type,  message_type  )  ==*  0  )  ) 
return (  list  ) ; 

list  =  list->next; 

> 

return (  (LIST  *)NULL  ); 

)  /*  find  list  */ 


void  print_list(  file,  list  ) 
register  FILE  *file; 
register  LIST  'list; 

( 

while  (  list  !-  (LIST  *)NULL  ) 

( 

switch  (  list->usage  ) 

( 

case  'S': 

fprintf(  file,  "\tCALL  SEND_%s(  %s  )\n",  list->message_type,  list 

>identif ier  ) ; 

break; 


case  'R' : 


>identif ier 

1 


fprintf ( 
break; 


file. 


"NtCALL  RECEIVE  %s (  %s  )\n”. 


list->message_type,  I 


list  =  list->next; 

1 

)  /*  print_list  */ 


void  delete  list(  list,  identifier,  message_type  I 

register  LIST  **list; 

register  char  "identifier; 

register  char  *message_type; 

i 

register  LICT  "last  =  (LIST  * ) NULL; 
register  LIST  "curr  =  "list; 


while  (  curr  !=  (LIST  * ) NULL  ) 
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if  (  (  stremp!  cur r-> ident i f i e r ,  identifier  )  ==  0  ) 

SS  (  stremp!  curr->uessage_f;ne,  ires sage  tyoe  )  =-  0  )  ) 

{ 

if  (  last  ==  (LIST  * ) NULL  ) 

•list  =  curr->next; 

else 

last->next  =  curr->next; 
break; 

} 

last  -  curr; 
curr  =  cur' — >next; 

/ *  delete  list  ’  / 


FILE:  network/network/1 ibrary /message_type_length . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
’  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <string.h> 


int  message_type_length (  message_type  ) 
register  char  *message_type; 

( 


if 

(  strcmp(  "CHARACTER_08BIT",  message_type 
return  (  2  )  ; 

> 

==  0 

if 

(  strcmp(  "COMPLEX_32BIT",  message_type  ) 
return!  8  ); 

- 

=  C  ) 

if 

(  strcmp(  "COMPLEX_64BIT" ,  message  type  ) 
return  (  1C  ) ; 

= 

=  0  ) 

if 

(  stremp!  "LOGICAL_08BIT" ,  message  type  1 
return!  2  ); 

- 

=  0  ) 

if 

(  stremp!  "L0GICAL_1 6BIT" ,  message  type  ) 
return (  2  ) ; 

= 

=  0  ) 

if 

(  stremp!  "LOGICAL  32BIT",  message  type  ) 
return  (  4  ) ; 

= 

=  0  ) 

if 

(  stremp  (  "REAL_J2BIT" ,  message  type  ) 
return (  4  )  ; 

0 

) 

if 

(  stremp!  "REAL  64BIT",  message  type  )  == 
return  !  8  ) ; 

0 

) 

if 

{  stremp (  "SIGNED  08BIT",  message  type  ) 
return  (  2  ) ; 

0  ) 

if 

(  stremp (  "SIGNED  16BIT",  message  type  ) 
return}  2  ); 

=  = 

0  ) 

if 

(  stremp {  "SIGNED  32BIT",  message  type  ) 
return  {  4  ) ; 

0  ) 

if 

(  stremp!  "UNSIGNED  08BIT",  message  type 
return (  2  ) ; 

) 

==  c 

if 

(  strcmp(  "UNSIGNED  16BIT",  message  type 
return  (  2  ) ; 

) 

==  0 

if 

(  stremp (  "UNSIGNED  32B1T",  message  type 
return  (  4  ) ; 

) 

==  0 

fprinef(  stderr,  "ERROR:  message_type_iength (  %s  )\n",  message_type  ); 
exit (  -1  )  ; 

)  /*  message_type_length  */ 

FILE:  network /network/! ibra  ry /message_cype_name  .  c 

/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 
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*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 
((include  <string.h> 


char  *message_type_name (  message_type  ) 
register  char  *message_type; 

{ 


if 

(  strcmp!  "CHARACTER  08BIT",  message  type 
return (  "CHARACTER* 1 "  ); 

)  ==  0 

(  strcmp!  "COMPLEX  32BIT",  message  tyce  ) 
return (  "COMPLEX'S"  ); 

==  0  ) 

if 

(  strcmp(  "COMPLEX  64BIT",  message  type  ) 
return (  "COMPLEX*16"  ); 

==  0  ) 

if 

(  strcmp(  "LOGICAL  08BIT" ,  message  tyoe  ) 
return (  "LOGICAL'l"  ); 

==  0  ) 

if 

(  strcmp!  “LOGICAL  leBIT".  message  type  ) 
return!  "L0GICAL*2"  ); 

==  0  ) 

if 

(  strcmp!  "LOGICAL  32BIT”,  message  type  ) 
return!  "LOGICAL'4"  ); 

==  0  ) 

if 

(  strcmp!  "REAL  32BIT",  message  type  )  == 
return!  "REAL* 4"  )  ; 

0  ) 

if 

(  strcmp!  "REAL  64BIT",  message  type  )  == 
return!  "REAL* 8"  ); 

0  ) 

if 

(  strcmp!  "SIGNED  08BIT",  message  type  ) 
return!  "INTEGER* 1 "  )  ; 

=  =  0  ) 

if 

(  strcmp!  "SIGNED  16BIT",  message  type  ) 
return!  "INTEGER*2“  ); 

=  =  0  ) 

if 

(  strcmp!  "SIGNED  32BIT",  message  type  ) 
return!  "INTEGER*--!"  )  ; 

=  =  0  ) 

if 

(  strcmp!  "UNSIGNED  08BIT",  message  type 
return (  “UNSIGNED  INTEGER'l"  ); 

)  ==  0  ) 

if 

(  strcmp!  "UNSIGNED  16BIT",  message  type 
return!  “UNSIGNED  INTEGER* 2 "  ); 

)  ==  0  ) 

if 

(  strcmp!  “UNSIGNED  32BIT",  message  type 
return!  "UNSIGNED  INTEGER"! "  ); 

>  ==  0  ) 

fprintf(  stderr,  "ERROR:  message_type  name ( 
exit(  -1  ) ; 

%s  ) \n". 

)  /*  message_type_name  */ 


message_type  ) 


FILE:  network/network/network . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  "list.h" 
♦include  "processor . h" 


extern  char  "duplicate!  ); 
extern  char  *message_type_r 'me (  ); 

PROCESSOR  processor!  NUMBER_PROCESSOR  J; 


♦define  PRIORITY  1000 

♦  define  DEF AULT_PRIORI TY  (  PRIORITY  *  PRIORITY  ) 


LIST  *pr i ori ty_l i st  =  (LIST  *)NULL; 
♦define  MULTIPLE  TRANSFER  1 
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void  input  _Dri.-i.  it  v_l  ist  (  file  ) 
register  FILE  "file; 

{ 

char  1 ine [  25  6  1  ; 

int  priority  =  PRIORITY; 

while  (  fgetsl  line,  sizeofl  line  ),  file  )  !=  (char  "(NULL  ) 

1 

lire[  strlen(  line  )  -  1  i  =  '\0'; 

if  (  line (  0  1  ==  ) 

{ 

priority  =  PRIORITY  +  (  (  priority  /  PRIORITY  )  *  PRIORITY  ) ; 

continue; 


add_list(  Spriority_list,  duplicate)  line  ),  0,  '\0',  priority++  ); 

} 

)  /*  input_priority_list  ’/ 


int  find_priority_list (  identifier  ) 
register  char  "identifier; 

( 

char  temporary [  256  ]; 
register  LIST  "list; 

strcpy(  temporary,  identifier  ); 

temporary!  strespn (  temporary,  "(>“  )  ]  =  '\0'; 

list  =  priority_list; 

while  (  list  ! =  (LIST  "(NULL  ) 

( 

if  (  strempf  li  st-->i.ii  i  f  ier,  temporary  )  ==  0  ) 
return)  1 i st ->pr i or i ty  ); 

list  =  list->next; 

) 

return (  DEFAULT ^PRIORITY  >; 

)  /*  f ind_priority_list  */ 


void  initialize_processor (  ) 

( 

register  int  processor_number; 

for  (  processor_number  =  0;  processor_number  '  =  NUM3ER_PRCCESS0R;  processor_r.umber^»  ) 
( 

processor!  processor_number  l.fiie_na.Te  =  (char  "(NULL; 

processor!  processor_number  i.s  =  0; 

processor!  processor_number  ).r  =  3; 

processor!  processor_number  ’.list  =  (LIST  "(NULL; 

) 

)  /*  initialize_processor  */ 


void  input_list(  processor_nun-r>er  ) 
register  int  processor_number; 

( 

FILE  "file; 

char  line [  256  1  ; 

chzr  identifier!  256  J  ; 

char  message_type [  256  ]; 

char  usage; 

int  priority; 

if  (  (  file  =  fopen (  processor!  processor_number  !.file_name,  "r"  )  )  ==  (FILE  "(NULL 

) 

( 

fprintfl  stderr,  "ERROR:  unable  to  open  for  read  '%s'\n",  processor; 
processor_number  ].file_name  ); 
ex i t (  -1  )  ; 

i 

while  (  fgetsl  line,  sizeofl  line  ),  file  )  (char  "(NUli  ) 

( 

if  (  sscanf  (  line,  "%s  %s  %c\r.",  identifier,  messagetype,  Susage  )  !  =  3  ) 

( 
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fprintf(  stderrr,  “ERROR:  jracle  ■ o  parse 
exit (  -1  ) ; 


if  (  strcmpl  messuge_type,  “ REAL_ 3231 T _AS_ & t BIT 
strcpy(  messaqe_type,  "REAL323LT"  ); 

if  (  strcmpl  message_type,  "REAL_6",3IT_AS_32BIT 
strcpyj  message^tyoe,  "REAL_6t3’T"  ); 

switch  (  usage  ) 

( 

case  ‘S': 

processor'  processar_r.urr.ber  ’.st»; 
priority  •  f ind_pr iority_i ist (  icentifti 
breax ; 


case  '  R  ’  : 

processor!  processor  number  1 .r-*: 
priority  =  lefault_?r:cr:ty; 
break; 


add  list  (  (processor!  processor  nurtber  j.list, 
priority  ):~ 


fclosel  file  ); 
1  /*  input_list  */ 


void  output_transfer (  file,  identifier,  messaqe _type,  ■ 

register  FILE  'file; 

register  char  'identifier; 

register  char  'messaqe_type; 

register  char  'usage; 

register  char  delimeter; 
register  int  s,  r; 
register  int  priority; 

delimeter  =  1  * ; 

for  (  r  =  0;  r  ! =  NUMBER ^PROCESSOR;  rw  ) 

{ 

if  (  usage!  r  ]  *«  *R*  ) 

i 

priority  =  processor!  r  ].list->pricrity; 

fprintf(  file,  "%c  p%02a",  delimeter,  r  ); 

delete  list!  ^processor!  r  j.list,  identifi 

delimeter  -  ’ , ' ; 

} 


f p r i n t f (  file,  M  :="  ); 
delimeter  =  ’  •  ; 

for  (  s  =  0;  s  !=  NUMBER^PROCESSOR;  s+^  ) 

{ 

if  (  usage!  s  ]  =  =  *S*  ) 

i 

priority  =  processor!  s  j  .  iist->pncrity; 

fprintf(  file,  "%c  p%C2d",  delimeter,  s  ); 
deiete_iist{  ^processor-  s  j.list,  identifi 

delimeter  =  ' , ' ; 

} 

\ 

fprintf(  file,  ”.%d;  [  %s  %s  %d  J  \r.M,  message_type 

message_type_name (  message_type  ),  identifier,  priorit 
}  f*  output_t rans fer  */ 


int  and_usage  (  usagel,  usage2  ) 
register  char  *usaqel; 
register  char  * usage 2; 

j 

register  int  processo r_ numbe r  =  C; 


ne  '  % s  1  '  r. ■*  ,  are  )  ; 

M  )  ==  C  ) 

"  )  =*■  0  ) 

ar  )  ; 

identifier,  message_ty 

usage  ) 


er,  m.essage_type  )  ; 


er,  message_type  ); 

length!  message_type  J 

y  i : 
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while  (  usaqel  [  orocessor  _n  umbo  r  ,  !=  '\C'  I  is  (  usaqe2!  processor  number 

)  ) 

( 

if  (  (  usaqel  [  processor_nur".ber  j  )  Si  (  usaqe2  [  processor  number 

)  ) 

re-urn (  1  !  ; 
precessa  r_r,un\be  r  *  +  ; 


return (  0  ) ; 
/*  and_usage  '/ 


mar  'or _:saqe(  usaqel.  usage2  ) 
register  char  ■ usaqel; 
register  cr.ar  *usage2; 

static  char  usage  [  NUMBER_PRCCESSCR  •  j; 
register  inc  processor_nurr.ber  -  C; 

while  (  (  usaqel  (  processor_number  1  !=  '\C'  )  Si  (  usage2  [  processor_nuT.ber  j  !=  '\0' 

)  ) 

usage  [  processor_number  1  - 

if  (  usaqei  [  processcr_nurr.ber  ;==••) 

usage[  processor_number  ]  =  usaq'2!  processor'_number  ]; 

if  (  usage2[  processor_number  1  ==  ) 

usage!  processor_number  1  =  usagel  [  processor_nurr\ber  ]  ; 

processcr_r.umber  +  -; 

usage!  processor_number  ]  =  ' \0’; 

return (  usage  ) ; 

}  /*  or_usage  */ 


int  usage_cycle(  ) 

I 

register  int  s,  r; 

register  LIST  'list; 

register  int  number_t ransfer  =  C; 

for  (  s  =  0;  s  '=  N UMBER _PROCES SCR;  so  ) 

i 

strepyi  processor!  s  usage,  “ - "  ); 

if  (  processor!  s  j.list  -=  (LIST  *)N'JLL  ) 
cont inue; 

if  (  processor!  s  | .  1  i st - vusage  !=  'S'  ) 
cont inue; 

processor!  s  i. usage!  s  -  'S'; 

for  (  r  -  0 ;  r  '=  NUM8ES_?R0CESSCR,-  r* *■  ) 

! 

if  (  processor!  r  j.list  -=  (LIST  '(NULL  ) 
cont inue; 

if  (  r  ==  s  ) 

Conti nue ; 

if  (  (  list  =  find_iisti  processor!  r  j.list,  processor'  s  j  .  1 i st -> ldent i  : . er , 

processor!  s  j  .  1  i st -ones sage  t ype  )  )  !=  (LIST  '(NULL  ) 

1 

if  !  list  !=  processor!  r  j.list  ) 

( 

strcpy(  processor;  s  j  .usage,  " - "  i  ; 

goto  incomplete; 


processor;  s  ]. usage;  r  -  ’ R‘; 


i 
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number_t ransfer++; 
i  ncomplete : 


return  (  number^f ransf er  ); 
/*  usage_cycle  */ 


int  next,  sender  {  ) 

register  int  r 
register  ir.t  ri  rity; 

=  \UMBF.R_PR0CESS0R; 
priority  =  LEFAUL7_?RI OR I T  Y  r 

for  (  r  =  C;  r  !=  NUMBER_PROCESSCR;  r -*-•*-  ) 

{ 

if  (  processor!  r  j.list  «=  (LIST  *)NULL  ) 
cont i nue ; 

i f  {  count (  processor [  r  ]. usage,  strien  (  processor!  r  j. usage 
NUMSER_?..JCESSOR  ) 

if  (  processor!  r  ] . I Lst->pr ior i ty  <  priority  ) 

{ 

s  -  r; 

priority  =  processor!  r  !. list-: priority; 


return  '  s  ) ; 

}  /*  next  sender  */ 


void  output _cy cl e (  file,  usage  ) 
register  FILE  *  f i 1 e ; 
register  char  *usage; 

register  int  s,  r; 

register  int  priority  =  L>EFAULT_PRICRITY  ■*  1; 

while  (  (  s  =  next  _ser.de  r  (  )  )  '.  =  NUM3ERJPRCCESS0R  ) 

{ 

if  <  and_usage  (  usage,  orocessor'  s  j. usage  )  ==  0  ) 

( 

-f  i  processor!  s  ; . 1 i st->pr iority  <  priority  ) 

priority  =  PRIORITY  +  (  (  processor!  s  j  . li st->priority 

PRIORITY  ) ; 

strcpy{  usage,  or_usage{  usage,  processor!  s  ]. usage  ) 
output_t ransfer (  file,  processor!  s  1 ,list->identifier, 
] . 1 i st ->message  type,  processor!  s  \ .usage  ); 

) 


# i fndef 
#  e  r,  J  l  f 


MULT I P  LL_TRANSFER 
break ; 


strcpy(  irocessor! 
/*  output  cycle  */ 


1 . usage , 


void  out  put  network  (  file  ) 
leqister  FILE  *fiie; 
l 

char  usage r  NUMBER  PROCESSOR  *  1  ]; 
reaister  int  cycle  *  0; 

fprirtf{  file,  "LOO?\n\nM  ); 

vhue  {  usaqe_cycie(  )  !-  0  ) 

{ 

st  rcpy  (  usage,  " - "  )  ; 


)  ,  1  ) 


/  PRICRIT 

) ; 

processor 

■ "  )  ; 
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fprintfl  file.  "CYCLE  [  %d  ]\n",  ++cycie  ); 
output_cycle (  file,  usage  )  ; 
fprintfl  file,  "\n"  ); 

1 

1  /*  output_network  */ 


void  output_processor (  file  ) 
register  FILE  "file; 

( 

register  int  number; 
register  int  number_error  =  0; 


for  (  number  =  0;  number  !  -  NUMBER_PROCESSOR;  number4-"-  ) 
f 


f  {  processor:  nu 

mber  ]  . 

file 

name  ! =  { 

char  • ) NULL 

i 

fprintf I 

file, 

" ;  "  ) ; 

strcpyl  i 

ndex  ( 

processor [ 

number  ] . 

file  name,  ' . 

.  ■  ),  ".for"  ) ; 

fprint  f  I 

f  iie. 

"p%02d 

=  %  s 

” ,  numbe  r 

,  processor! 

number  l.file_name  ); 

fprintf  I 

file. 

",  S  = 

%  3d" 

,  processor [  number  ]. 

.  s  )  ; 

fprintf  I 

file. 

”,  R  = 

%3d" 

,  processor [  number  ], 

.  r  )  ; 

fprintf  I 

file. 

”,  %  3  d ' 

",  pl 

ocessor [ 

number  ] . s  + 

processor!  number  ! .r 

fprint  f ( 

file. 

"  ]  \  n" 

) ; 

if  (  processor!  number  [.list  !  =  (LIST  *)NULL  ) 

( 

print_list(  file,  processor!  number  l.li«"  ); 
f  p  r i n  t  f (  file,  " \ n "  ) ; 


1 


number  error44; 


if  (  number_error  !=  0  ) 

( 

fprintf(  file,  "ERROR:  %d  processor (s)  with  unresolved  communication\n", 
number_error  ) ; 

fprintfl  stderr,  "ERROR:  %d  processor (s)  with  unresolved  communication\n", 
number_error  ) ; 
i 

)  /*  output_processor  */ 


#define  PROGRAM  argument!  0  ) 

#define  ARGUMENT  argument!  argument_numoer  ! 


int  main!  number_argument,  argument  ) 
register  int  number_argument; 
register  char  "argument!  ); 

( 

register  int  argument_number  =  0; 
int  processor_number; 
char  file_name[  256  ]; 

if  (  --number_argument  =  =  0  ) 

( 

fprintfl  stderr,  "usage:  %s  0C=<file  name> . . . 31=<f ile  name>\n",  PROGRAM  ); 
exit  (  0  )  ; 

I 

input_priority_list (  stdin  ); 
i ni t i al i ze_processor (  ); 

while  (  argument_number+ 4  !-  number_argument  ) 

( 

if  (  sscanf (  ARGUMENT,  "%a-%s”,  4processor_number,  file_name  ) 

{ 

fprintfl  stderr,  "rDor'R :  unable  to  parse  argument  ’%s’\n", 
exit!  -1  ) ; 

) 

processor!  processor_number  ].file_name  =  duplicate!  file_name  ); 
inputlistl  processor_number  ); 

> 


!  =  2  ) 

ARGUMENT  ) ; 


391 


392 


Annual  Report:  Digital  Emulation  Technology  Laboratory  Volume  1,  Part  2 


outpuc_necworJc  (  stdnnr  >  ; 
output_processor (  stdout  ); 

exit (  0  ) ; 

(  / *  main  * / 
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17.  Appendix  L:  structure  program  source 

FILE:  structure/Makefile 


# 

#  Copyright  1991 

ft  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtei 

# 


default:  st 


re 


CC  =  cc  -g 
INCLUDE  =  include 
CFLAGS  =  -IS (INCLUDE) 
LIBRARY  =  library/library . a 


OBJECTS  =  \ 

$ (INCLUDE) /grammar. h  \ 
•grammar. [co]  \ 

*  scanner . (co]  \ 
yy trace .  [  co  ]  \ 
y . output 


PROGRAMS  =  \ 
•structure 


grammar. c:  grammar. y 
yacc  -dv  grammar. y 
mv  y.tab.h  S  ( INCLUDE) /grammar . h 
mv  y.tab.c  grammar. c 


scanner. c:  scanner. 1 

lex  -vt  scanner. 1  I  sed  '  s/getc/yygetc/ '  >scanner.c 


scanner. o:  scanner. c  S ( INCLUDE) /grammar .h 
$ (CC )  S (CFLAGS)  -c  scanner. c 

grammar. o:  grammar. c 

S(CC)  S (CFLAGS)  -c  grammar.c 

structure:  grammar. o  scanner. o  S (LIBRARY) 

S(CC)  -o  structure  grammar. o  scanner. o  S (LIBRARY) 


sorammar . c : grammar . c  yytoken.awk 

awk  -f  yytoken.awk  <grammar.c  >sgrammar.c 

sgrammar.o: sgrammar.c 

S (CC)  S (CFLAGS)  -c  sgrammar.c 

sstructure: sgrammar.o  scanner. o  S (LIBRARY) 

$(CC)  -o  sstructure  sgrammar.o  scanner. o  S (LIBRARY) 

dscanner.c:  scanner. c 

cp  scanner. c  dscanner.c 

dscanner . o : dscanner.c  S (INCLUDE) /grammar . h 
S(CC)  S (CFLAGS)  -DDEBUG  -c  dscanner.c 

dstructure : grammar . o  dscanner. o  S (LIBRARY! 

S (CC)  -o  dstructure  grammar. o  dscanner. o  S(LIBRARY) 


tgramma  r . c : grammar . c 

sed  ' s/yystack : /S  yytrace (yystate) ; / 1  <grammar.c  >tgrammar.c 


tgrammar.o: tgrammar.c 

S (CC)  S (CFLAGS)  -c  tgrammar.c 
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t st ructure : tgrammar . o  scanner. o  yytrace.o  S (LIBRARY) 

$  (CC)  -o  cstructure  tgraminar.o  scanner. o  yytrace.o  $(LIBRARY) 


yytrace.c:  grammar. c  yytrace.awk 

awk  -f  yytrace.awk  <y. output  >yytrace.c 

yytrace.o:  yytrace.c 

$(CC)  S(CFLAGS)  -c  yytrace.c 


clean : 

cci  library;  make  clean 
rm  -f  S (PROGRAMS)  S (OBJECTS) 


FILE:  st ructure /gramma r . y 


/’ 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


/* 

*  FORTRAN  11 

*/ 


%token  RW_AND 
%token  RW_ASSIGN 
ttoken  RW_BACK SPACE 
%token  RW_BLOCK_OATA 
%token  RW_CALL 
ttoken  RW_CHARACTER 
ttoken  RW_CLOSE 
ttoken  RW_COMMON 
ttoken  RW^COMPLEX 
ttoken  RW_CONTINUE 
ttoken  RW~0ATA 
ttoken  RW~D I MEN SION 
ttoken  RW_DO 

ttoken  RW_DOUBLE_PRECISION 

ttoken  RW_ELSE 

ttoken  RW_ELSE_IF 

ttoken  RW_END 

ttoken  RW_END_IF 

ttoken  RW_ENDFILE 

ttoken  RW_ENTRY 

ttoken  RW_EQ 

ttoken  RW_EQUI VALENCE 

ttoken  RW_EQV 

ttoken  RW_EXTERNAL 

ttoken  RW_FALSE 

ttoken  RW_FORMAT 

ttoken  RW_FUNCTION 

ttoken  RW_GE 

ttoken  RW_GO_TO 

ttoken  RW_GT 

ttoken  RW_IF 

ttoken  RW_IMPLICIT 

ttoken  RW_INCLUDE 

ttoken  RW_INQUIRE 

ttoken  RW_INTEGER 

ttoken  RW_ INTRINSIC 

ttoken  RW_LE 

ttoken  RW_LOGICAL 

ttoken  RW_LT 

ttoken  RW_NAMELIST 

ttoken  RW_NE 

ttoken  RW_NEQV 

ttoken  RW_NOT 

ttoken  RW_OPEN 

ttoken  RW_OR 

ttoken  RW_PARAMETER 

ttoken  RW_PAUSE 

ttoken  RW_PRINT 

ttoken  RW  PROGRAM 
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♦token  RW_READ 
♦token  RW_REAL 
♦token  RW_RETURN 
♦token  RW_REWIND 
♦token  RW_SAVE 
♦token  RW_STOP 
♦token  RW_SUBROUTINE 
♦token  RW_THEN 
♦token  RW_TO 
♦token  RW_TRUE 
♦token  RW_WRITE 
♦token  RW  UNDEFINED 


♦token  COMMENT 
♦token  CONCATENATE 
♦token  DOUBLE_PRECISION 
♦token  EXPONENTIATE 
♦token  HOLLERITH 
♦token  IDENTIFIER 
♦token  INTEGER 
♦token  LABEL 
♦token  REAL 
♦token  STRING 


♦  left  ' ,  ■ 

♦nonassoc  '  :  1 
♦right  •=' 

♦left  RW_EQV  RW_NEQV 
♦left  RW_OR 
♦left  RW_AND 
♦left  RW_NOT 

♦nonassoc  RW_EQ  RW_NE  RW_LT  RW_LE  RW_GT  RW_GE 
♦left  CONCATENATE 
♦left  '+' 

♦left  '*•  ’/' 

♦right  EXPONENTIATE 
♦left  SIGN 


♦  { 

typedef  char  "POINTER; 

♦define  YYSTYPE  POINTER 

♦include  "list.h" 
static  LIST  *block_list  =  0; 
static  LIST  *subprogram_list; 
static  LIST  *array_list; 

static  POINTER  block_name; 
static  int  block_type; 

♦  I 


♦  ♦ 


program: 

opt ional_statement_l  i  st 

( 

summary!  block_list  )  ; 

) 


optional  statement_list : 
/*  NULL  */ 

I 

statement  list 


statement_list : 

statement 

I 

statement  list  statement 


statement : 
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comment_statement 

I 

label  unlabeled  statement 


comment_statement : 
COMMENT 


label: 

LABEL 


unlabeled_statement : 

inciude_st a cement 
I 

program_statement 

I 

block_data_st at ement 
I 

function_statement 

i 

subrout ine_st at ement 
I 

entry  statement 

I 

end  statement 
I 

specif ication_st a t ement 
l 

executable_s tat ement 

I 

format  statement 


incl ude_statement : 

RW  INCLUDE  character  constant 


program_statement : 

RW_PROGRAM  program_ident i f ier 


program_identif ier: 

IDENTIFIER 

< 

block_name  =  SI; 
block_type  =  RW_PROGRAM; 
array_list  =  0; 
subprogram_list  =  0; 

) 


block_data_statement : 

RW  BLOCK  DATA  block  data  identifier 


block_data_identi fier : 

IDENTIFIER 

( 

block_name  =  SI; 
block_type  =  RW_BLOCK_DATA; 
array_list  =  0; 
subprogram_list  =  0; 

) 


function_statement : 

RW_FUNCTION  f unct ion_ident i f i e r  opt iona i_f ormal _a rgument _1 i st 
I 

type  RW_FUNCTION  f unct i on_ident i f ier  opt ional_f orma l_argument 


ist 
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function_ identifier: 

IDENTIFIER 

( 

block_name  =  $1; 
block_type  =  RW_FUNCTION; 
array_list  =  0; 
subprogram_list  =  0; 

) 


subroutine_stateme-it : 

RW_SUBROUr'iNE  subrout  ine_ident i  fier 

) 

RW_SUBRCUTINE  sub  rout  me_idenc  i  fier  opt  ionai_f  ormai_argument_l  i  sc 


subrout ine_identi fier: 

IDENTIFIER 

( 

biock_name  »  SI; 
b’.oclc_type  =  RW_SUBROUTINE; 
array_list  =  0; 
subprogram_list  =  0; 

} 


statement : 

RW_ENTRY  entry_identi f ier 

RW_ENTRY  entry_identifier  opt ional_forma l_argument_i i st 


entry_identif ier: 

IDENTIFIER 


opt ional_formal_argument_l ist : 

I 

•('  formai_argument_l ist  ')' 


formal_argument_list : 

formal_argument 

I 

formal_argument_list  formal_argument 


f ormal_argument : 

IDENTIFIER 

I 

formal_argument_al ternate_return 


formal_argument_alternate_return: 


end_statement : 

RW_END 

( 

add_list(  Sblock_list,  block_name,  blocktype,  subprogram_l i st  ); 
delete_iist(  array_list  ); 

) 


speci f icat ion_statement : 

external  statement 


entry 

I 
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int rinsic_statement 

parameter_statement 

dimension_statement 

declaration_statement 

save_statement 

common_statement 

equi valence_statement 

implicit_statement 

data_statement 

namelist  statement 


external_statement : 

RW  EXTERNAL  external  list 


external_list : 

external 

I 

external  list  external 


external : 

IDENTIFIER 


int rinsic_statement : 

RW  INTRINSIC  intrinsic  list 


intrinsic_list: 

intrinsic 

I 

intrinsic  list  intrinsic 


intrinsic: 

IDENTIFIER 


parameter_statement : 

RW_PARAMETER  '  ('  parameter_list  ')  ' 


parameter_l ist : 

parameter 

I 

parameter_list  *, 1  parameter 


parameter: 

IDENTIFIER  expression 


dimension_statement : 

RW  DIMENSION  dimension  list 


dimension_list : 

dimension 
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dimensi on_l i st  dimension 


dimension: 

IDENTIFIER  1  ( ' subscript_l ist  ')' 

( 

if  (  find_list (  array_list,  $1 

( 

add_Iist (  Sarray_list,  SI, 

) 

) 


subscript_list: 

subscript 

I 

subscript_list  subscript 


subscript : 

upper_bound 

I 

lower_bound  ' : '  upper_bound 


lower_bound : 

expression 


upper_bound: 

lower_bound 

I 

upper  _bour.d_aa  jus  table 


upper_bound_ad justable : 


declarat ion_statement : 

type  declaration_list 


decl a rat ion_l ist: 

declaration 

I 

declaration_list  declaration 


declaration : 

IDENTIFIER  opt ional_type_length 
I 

IDENTIFIER  '('  subscript_l i st  ')'  optional_type_length 

( 

if  (  find_list(  array_list,  SI  )  ==  0  ) 

( 

add_list  (  &array_Iist,  SI,  0,  0  ) ; 

) 

} 


type: 

type_name  optional_type_length 


type_name : 

RW  CHARACTER 


)  ==  C  > 
0 ,  0  )  ; 


RW  COMPLEX 
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i 

RW_DOUBLE_PRECISION 

I 

RW_INTEGER 

I 

RW_LOGICAL 

I 

RW_REAL 

I 

RW_UNDEFINED 

optional  typelength: 

/*  NULL  */ 

\ 

type_length 


type_length: 

...  xjitEGER 

I 

type_length_ad justable 


type  length_ad justable : 


save_statement : 

RW_SAVE  optional_save_list 


optional  save_list: 
/*  NULL  */ 

I 

save  list 


list : 
save 

save  list  1 , *  save 


save : 

IDENTIFIER 

I 

common  name 


save 


common_st atement : 

RW_COMMON  opt ional_common_name  common^list 


optional  common__name : 
r*  NCJLL  */ 

i 

common  name 


common_name : 

V*  optional_ident if ier  */' 


optional  identifier: 
/*  NULL  */ 


IDENTIFIER 


17.  Appendix  L:  structure  program  source 


401 


common_l i  s  t : 

common 

I 

common_list  common 


IDENTIFIER 

IDENTIFIER  • C  subscript_I i st  ■)■ 

( 

if  (  find_list(  array_list,  $1  )  ==  0  ) 

f 

add_list;  sarray_Iist,  SI,  0,  0  ); 


equi valence_statement : 

RW_EQUIVALENCE  equi vaience_i i st 


equivalence_list : 

equivalence 

I 

equivalence_list  ' equivalence 


equivalence : 

'  ( '  variable  list  ' )  ' 


variable_l ist : 

variable 

I 

variable_l i st  variable 


impl icit_statement : 

RW_IMPLICIT  type  '('  impl ici t_l i st  ')' 


implicit_list : 

implicit 

I 

implicit_list  implicit 


implicit : 

IDENTIFIER 

I 

IDENTIFIER  IDENTIFIER 


namelist_statement: 

RW  NAMELIST  namelist  name  namelist  list 


namel ist_name : 

'/'  IDENTIFIER  ’/’ 


namelist_list : 

namelist 

I 

namel i st_l i st  namelist 
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namelist : 

IDENTIFIER 


data_statement : 

RW  DATA  data  list 


data_li st : 

data 

I 

data_list  optional_ccmma  data 


data : 

data  variable  list  '/'  data  constant  list  '/' 


dat a_var iablel i st : 

data_variable 

I 

data  variable  list  data_variable 


data_variable: 

variable 

I 

data_implied_do_l 1st 


data_impl ied_do_l i st : 

'('  data_variable_list  IDENTIFIER  ■='  expression_list  ') 


data_constant_list: 

data_constant 

I 

data  constant_l i st  data  constant 


data_constant : 

data_initializaticn 

I 

IDENTIFIER  data_ini t i al i zat icn 

INTEGER  data_ini t lal i zat ion 

data_initialization: 

IDENTIFIER 

i 

character_constant 

I 

loqical_constant 

I 

signed_numerical_constant 


signed_numerical_constant : 

numerical_constant 

I 

' +  '  numerical_constant  %prec  SIGN 

i 

numerical_constant  %prec  SIGN 


expression: 

parent  hesisexpressior. 


simple_expression 
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parenthesis_expression: 

' ( '  expression  1 ) ' 


sirrple_expressi  on : 
variable 

I 

constant 

I 

ari thmet ic_expression 

i 

character_expressio" 

reiational_expression 

iogical_expression 

I 

una  ry_expressi on 


var laDle : 

IDENTIFIER 

IDENTIFIER  st ri ng_subset 

I 

array 


at  ray : 

IDENTIFIER  '('  opt iona 1 _expression_l i st  ■ ; • 

{ 

if  (  find  list!  array  list.  Si  )  ==  0  ) 

< 

add_list(  &subprogram_l i st ,  SI,  0,  S  ); 
f 
t 

IDENTIFIER  '('  opt i ona 1 _expres s i cn_i i st  •)'  st r i ng_s^bse t 
( 

if  (  find  list  (  array  list,  SI  >  —  =  G  ) 
f 

ndd_list(  Ssubprogram_!ist,  SI,  0,  0  ); 

) 

) 


optional  expression_l ist : 
/*  NULL  */ 

I 

expression_list 


expression_list: 

expression 

I 

expres s i on_l  i  st  expression 


st  r i ng_subset : 

'('  opticrMi  expression  opt  i  ona  lexpress  i  on  1 )  1 


optional  expression: 
7*  NULL  */ 

expres?  o 


constant : 

character  constant 
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logical_const ant 

I 

rjumerica  I_constant 

character_constant : 

HOLLERITH 

I 

STRING 

logical  constant: 

RW_rALSE 

RW_TRUE 

numc  r  leal  _  const  ant : 

D0UBLE_PRECISI0N 

INTEGER 

REAL 

ari  thrr.et  ic_expressicn : 

expression  ' +•  expression  %prec  '+' 

I 

expression  expression  %prec 

I 

expression  ,mt  expression  %prec 

f 

expression  */"  expression  %prec  '/' 

I 

expression  EXPONENTIATE  expression  %prec  EXFONENTIATE 

character_expression : 

expression  '/*  '/'  expression  %prec  CONCATENATE 

reiationai_expression: 

expression  RW^EQ  expression  %prec  RW  EC 

expression  RW_NE  expression  %prec  RW_NE 

expression  RW_LT  expression  %prec  RW_LT 

expression  RW_LE  expression  %prec  RW_LE 

i 

expression  RW_GT  expression  %prec  RW_GT 

expression  RW_GE  expression  %prec  RW_GE 

iogicai__expression : 

expression  RW_AND  expression  %prec  RW_AND 

I 

expressior.  "W  OR  expression  %prec  RW  OR 
I 

expression  RW_EQV  expressior.  %prec  RW_ECV 
expression  RW  NEQV  expression  %prec  RW  NEQV 

una  ry_ex press i on : 

'  ♦*  expression  Isprec  SIGN 

'  -  '  expression  %prec  SIGN' 

RW_NOT  expression  %prec  RW_NCT 
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able_st atement : 
do_st atement 

logical  i  f_staterrent 

block_i f_statement 

el se_statement 

e 1 se_i f _stat ement 

end_i f_statement 

sub  set  _execut  ablest,  a  cement 

do_statement : 

RW_D0  INTEGER  IDENTIFIER  '  =  '  expression_list 


logical  if  statement: 

i f_expression  subset_executabie_statement 


i f_expression : 

RW_IF  *('  expression  ')' 


block_i f _st at ement : 

RW_IF  '('  expression  ' )'  RW_THEN 


execut 


I 


I 


el se_st atement : 

RW  tLSE 


el se_i  f__st  atement : 

RW_ELSE_IF  • ( *  expression  ' ) *  RW_THEN 


end  if  statement: 

RW_EN0_I r 

execut abie_st atement : 
assignmen t _st atement 

assign_st atement 

ar i thmet ic_i f_statement 

cont inue_st atement 

cal l_st atement 

return_st  atemer. 

uncondi t i ona!_go  to_statement 

computed_go_to_st atement 

assigned_go_to_st atement 

stop_statement 

pause_st atement 


subset 

I 

i 


io  statement 
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assignment_statement : 

variable  '  =  '  expression 


assign_statement : 

RW  ASSIGN  INTEGER  RW  TO  IDENTIFIER 


arithmetic_i f_statement : 

kW_IF  '('  expression  ')'  integer_list 


continue_statement : 

RW  CONTINUE 


call_statement : 

RW_CALL  IDENTIFIER 

{ 

add_list (  Ssubprogram_list,  $2,  0,  0  ); 

) 

I 

RW_CALL  IDENTIFIER  optional_actual_argument_list 

{ 

add_list(  Ssubprogram_list,  $2,  0,  0  ); 

} 


optional_actual  argument_list : 

I 

'('  actual_argument_list  ')' 


actual_argument_list : 

actual_argument 

I 

actual_argument_list  actual_argument 


argument : 
expression 

actual_argument_  al ternate_return 


actual_argument_ai ternate_return : 
'  *  '  INTEGER 


return_statement : 

RW_RETURN  optional  expression 


unconditional_go_to_statement : 
RW  GO  TO  INTEGER 


computed_ga_to_statement : 

RW_GO_TO  '('  integer_list  opt iona l_comma  expression 


assigned_go_to_statement : 

RW_G°_TO  IDENTIFIER 

t 

RW_GO_TO  IDENTIFIER  cptionai_conrr.a  ’  ('  int ege r _1  r st  ')’ 


actual 

I 
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optional  comma: 

/*  NULL  */ 


integer_list : 

INTEGER 

I 

integer_list  INTEGER 


pause_statement : 

RW_PAUSE  optionaI_expression 


stop_statement : 

RW_STOP  optional_expression 


io_statement : 

open_statement 

I 

close_statement 

I 

inquire_statement 

I 

read_statement 

I 

write_st at sment 

I 

print_statement 

I 

backspace_statement 

I 

rewind_statement 

I 

endf ile_statement 

• 

open_statement : 

RW_0PEN  '('  control  information  list  ')' 


close_statement : 

RW_CL0SE  '('  control_information  list  ')' 


inqui re_rtatement : 

RW_INQUIRE  '('  control  information  list  ’)' 


read_statement : 

RW_READ  '('  control_information_list  ')'  optional_io_list 
I 

RW_READ  control 
I 

RW_READ  control  ' io  list 


write_statnment : 

RW_WRITE  '('  cont rol_in format ion_l ist  ')’  optional_io_list 


print _statement : 

RW_PRINT  control 

I 

RW_PRINT  control  io  list 
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backspace_statement : 

RW_BACKSPACE  " < '  cont rol_inf ormat ion_l 1 st  ' )’ 
I 

RW  BACKSPACE  control 


rewind  statement: 

~ RW_REWIND  '('  control_information_list  ')' 
I 

RW  REWIND  control 


endf ile_statement : 

RW_ENDFILE  •('  cont rol_inf ormat ion_l i st  ')' 
RW  ENDFILE  control 


cont rol_inf ormat ion_list : 

cont rol_in format ion 

I 

control  information_list  control_infcrmation 


cont rol_inf ormat ion: 
control 

I 

IDENTIFIER  expression 


control : 

variable 

I 

constant 

I 

•  *  « 


optional  io_list: 

F*  NULL  */ 
I 

io  list 


io_list : 

io 

I 

io  list  ' ,  '  io 


io : 


expression 
io_impl ied_do_l i st 


io_impl ied_do_li st : 

'('  io_list  IDENTIFIER  '='  expressi on_l i st  ')' 


format  statement: 
~  RW  FORMAT 


FILE:  st ructure/ include/list . h 
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/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


#define  LIST  struct  list_type 
LIST 
( 

cl.  - ‘ijtntiiier; 
int  type; 

LIST  *call_list; 

LIST  'next; 

}  ; 


extern  LIST  *end_list(  ); 
extern  LIST  *add_list (  ) ; 
extern  LIST  *find_list(  ); 
extern  void  print_list (  ) ; 
extern  void  delete_list(  ); 


FILE:  structure/library/Makefile 


* 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


CC  =  cc  -g 
INCLUDE  =  . ./include 
CFLAGS  =  -IS (INCLUDE) 
LIBRARY  =  library. a 


OBJECTS  =  \ 

duplicate,  o  \ 
hollerith.o  \ 
link_list.o  \ 
lowercase. o  \ 
main.o  \ 
non_blank.o  \ 
summary. o  \ 
yyerror.o  \ 
yygetc.o  \ 
yywrap. o 


$ (LIBRARY) : S (OBJECTS) 

ar  crv  $ (LIBRARY)  S (OBJECTS) 
ranlib  $  (LIBRARY) 


.SUFFIXES:  .c  .o 
.  c.  o: 

$(CC)  -C  S  (CFLAGS)  $< 


clean : 

rm  -f  $ (LIBRARY)  S (OBJECTS) 


FILE :  st ructure/1 ibrary /dupl icate  .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


linclude  <stdio.h> 
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((include  <string.h> 

((include  <malloc.h> 


char  ’duplicate (  string  ) 
register  char  ’string; 

( 

register  char  ’temporary  =  (char  ’(NULL; 

if  (  string  !=  (char  ’(NULL  ) 

{ 

if  (  (  temporary  =  (char  *)malloc(  strienf  string  )  +  1  )  )  '=  (char 

strcpyl  temporary,  string  ); 

else 

fprintft  stderr,  "ERROR:  duplicate!  %s  )\n“,  string  >; 

( 

return)  temporary  ); 

}  /’  duplicate  */ 


FILE:  st ructure/ library /hoi ler i th. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

’/ 


((include  <stdio.h> 


char  *hollerith(  string,  delimeter  ) 
register  char  ’string; 
register  char  delimeter; 

1 

int  hollerith_length; 
register  int  string_length  =  0; 

sscanf (  string,  "%dh",  thollerith_length  ); 

string!  string  length++  ]  *  delimeter; 
while  (  holler!th_length  !=  0  ) 

( 

if  (  (  string!  string  length  1  =  yyinput!  )  )  »«  '\n*  ) 

{ 

yyunput (  string!  string_length  )  ); 
break; 

} 

string  length++; 
hollerTth_length  —  ; 

> 

string!  string_length++  )  =  delimeter; 

string!  string_length  1  =  ’\Q’; 
return)  string  ); 

(  /*  hollerith  */ 


FILE:  structure/library/link_list . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <malloc.h> 
♦include  "list.h" 


’ ) NULL 


LIST  *end_list(  list  ) 
register  LIST  ’list; 
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if  (  list  !=  (LIST  * ) NULL  ) 

( 

while  (  list->next  !=  (LIST  '(NULL  ) 
list  =  list->next; 

) 

return (  list  ) ; 

/*  end  list  */ 


LIST  'add 
register 
register 
regi ster 
register 


_list(  list 
LIST  "list 
char  'ident 
int  type; 
LIST  'call 


,  identifier, 
i  f  ier; 
list; 


type,  call_list  ) 


t 

register  LIST  'temporary  =  (LIST  *)malloc(  sizeof( 


LIST  ) 


)  ; 


temporary->identi f ier  =  identifier; 
temporary->type  =  type; 
temporary->call_list  =  call_list; 
temporary->next  =  (LIST  '(NULL; 


if  (  'list  ==  (LIST  ' ) NULL  ) 

'list  =  temporary; 

else 

end  list(  'list  ) ->next  =  temporary; 


return!  temporary  ); 
)  /'  add_list  ’/ 


LIST  'find  list  (  list,  identifier  ) 
register  LIST  'list; 
register  char  'identifier; 

( 

while  (  list  !«  (LIST  ' ) NULL  ) 

{ 

if  (  strcmpl  list->identif ier,  identifier  )  ==  0  ) 
return (  list  ) ; 

list  »  list->next; 

} 

return (  (LIST  '(NULL  ); 

(  /*  find_list  */ 


void  print_list(  file,  list  ) 
register  FiLE  'file; 
register  LIST  'list; 

( 

register  LIST  *call_list; 

while  (  list  ! -  (LIST  '(NULL  ) 

i 

fprintf  (  file,  "%s:%d\n",  1 ist->ident i f ier,  list->type  ); 

call  list  =  list->call_list; 
while  (  cal 1_1 ist  !-  (LIST  '(NULL  ) 

f 

fprintf (  file,  "\t%s\n",  cail_list->identifier  ); 
call_list  =  call_list->next; 

) 

list  =  list->next; 

) 

}  /*  print_list  '/ 


void  delete_list(  list  ) 
register  LIST  'list; 

( 

if  (  list  '.=  (LIST  '(NULL  ) 

( 

delete_list(  list->next  ); 
free  (  list  ) ; 

( 
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I  /*  delete  list  */ 


FILE :  st ructure/ library /lowercase . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
'/ 


char  'lowercase (  string  ) 
register  char  'string; 

( 

register  int  index  =  0; 

while  (  string!  index  ]  !=  ’\0'  ) 

( 

string!  index  1  =  tolower  (  string!  index  ]  ); 
index++; 

} 

return!  string  ) ; 

)  /*  lowercase  */ 


FILE:  structure/library/main. c 


/' 

'  Copyright  1991 

'  Georgia  Institute  of  Technology 
*  Computer  Engineering  Research  Laboratory 
'  Author:  Stephen  R.  Wachtel 

'/ 


#include  <stdio.h> 


extern  FILE  'yyin; 
extern  FILE  'yyout; 


ddefine  PROGRAM  argument!  0  1 
#define  INPUT_FILE  argument!  1  1 
idefine  OUTPUT_FILE  argument!  2  ] 


int  main(  number_argument,  argument  ) 
int  number_argument; 
char  'argument!  ]; 

( 

if  (  number_argument  ==  1  ) 

( 

yyin  »  stdin; 
yyout  -  stdout; 

yyparsel  ); 
exit!  0  ); 

) 


if  (  number_argument  ==  3  ) 

{ 

if  (  (  yyin  =  fopen (  INPUT_FILE,  "r"  )  )  -=  (FILE  *)NULL  ) 

{ 

fprintfl  stderr,  "%s:  ERROR  -  unable  to  open  input  file 
INPUT_FILE  ) ; 

exit  (  -1  ) ; 


1 

if  (  (  yyout  =  fopen(  OUTPUT_FILE,  "w"  )  )  =-  (FILE  *)NULL  ) 

( 

fprintfl  stderr,  "%s:  ERROR  -  unable  to  open  output  file 
OUTPUT_FILE  ) ; 

exit  (  -1  )  ; 


%s'  n" ,  PROGRAM, 


' %  s ' \ n " ,  PROGRAM, 


> 
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yyparse  (  )  ; 
exit  (  0  )  ; 


fprintf!  stderr,  "usage:  %s  <input  file>  coutput  file>\n",  PROGRAM  ); 
exit  (  0  ) ; 

}  /  *  main  *  / 


FILE :  structure/ library /non_blanx . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Steone.n  R.  Wachtel 

*/ 


♦include  <string.h> 


char  *non_blank(  string  ) 
register  char  "string; 

{ 

register  int  offset; 
register  int  length; 


length  =  strlen(  string  )  -  1; 

while  (  (  String!  length  ]  ==  ‘  1  )  SS  <  string!  length 

string!  length —  ]  =  '\0‘; 

offset  »  0; 

while  (  (  string!  offset  )=='')  SS  (  string!  offset 
string!  offset++  J  =  '  \0'; 


strcpy(  string,  Sstring!  offset  ]  ); 


if  (  strlen!  string  )  !=  0  ) 

return!  string  ); 

else 

return (  0  ) ; 

)  /*  non  blank  */ 


•\0'  )  ) 

* \0  ■  )  ) 


FILE:  structure/library/summary. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <malloc.h> 
♦include  "grammar. h" 
♦include  "list.h" 


extern  FILE  *yyin; 
extern  FILE  *yyout; 


void  print_level (  level  ) 
register  int  level; 
f 

while  (  level--  !=  0  ) 

fprintf!  yyout,  "\t"  ); 
)  /*  print_level  */ 


void  print_trace(  block_list,  identifier,  level  ) 
LIST  *bl ock^l i st ; 
char  "identifier; 
int  level; 

{ 
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LIST  "list; 
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LIST  *call_list; 

((define  TRACE  0x10000000 

print_level (  level  ) ; 

fprintfl  yyout,  "%s\n",  identifier  ); 

if  (  (  list  =  find_list(  block_list,  identifier  )  )  ==  (LIST  *)NULL  ) 
return; 

if  (  (  list->type  i  TRACE  )  !=  TRACE  ) 

{ 

list->type  1=  TRACE; 

call_list  =  list->call_list; 
while  (  call_list  !=  (LIST  *)NULL  ) 

{ 

print_trace(  block_list,  cal 1_I ist-> ident i f ier,  level  +  1  ) ; 
call_list  =  call_list->next; 

} 

list->type  t-  -TRACE; 

) 

}  /*  print_trace  */ 


void  summary!  list  ) 
register  LIST  "list; 

( 

while  (  list  !=  (LIST  *)NULL  ) 

{ 

if  (  list->type  =**  RW_PROGRAM  ) 

print  trace)  list,  list->identifier,  0  ); 

list  »  list->next; 

1 

exit (  0  ) ; 

)  /*  summary  */ 


FILE:  structure/library/yyerror. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephan  R.  Wachtel 

*/ 


((include  <stdio.h> 


extern  int  yylineno; 


void  yyerror(  string  ) 
register  char  *string; 

( 

fprintfl  stderr,  "line  %d,  %s\n",  yylineno,  string  ); 

exit (  -1  ) ; 

)  /*  yyerror  */ 


FILE:  structure/library/yygetc.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


((include  <stdio.h> 
((include  <ctype.h> 
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extern  int  yylineno; 


int  tab!  length  ) 
register  int  length; 

( 

while  (  length —  !=  0  ) 
yyunput  (  ■  '  ) ; 

return (  •  •  ) ; 

)  /*  tab  */ 


int  yygetc(  file  ) 
register  FILE  ‘file; 
{ 

int  c; 

int  column!  6  ); 
loop: 


if 

(  (  c  =  getc! 

file  )  ) 

==  '\f 

) 

c  =  tab!  6 

)  ; 

if 

(  c  ! =  ■ \n' 

) 

return!  c 

; 

if 

(  (  column! 

0 

]  =  getc! 

file  ) 

)  !  = 

goto  abort 

0; 

if 

(  (  column! 

'l 

)  =  getc  ( 

file  ) 

)  !  = 

goto  abort 

1; 

if 

(  (  column! 

2 

!  =  getc( 

file  ) 

)  !  = 

goto  abort 

2; 

if 

(  (  column! 

3 

]  =  getc! 

file  ) 

)  !  = 

goto  abort 

3; 

if 

(  (  column!" 

4 

]  =  getc! 

file  ) 

)  !  = 

goto  abort 

4; 

if 

(  isspace  ( 

column!  5  ) 

=  getc( 

file 

goto  abort_5 


yylineno++; 
goto  loop; 

abort_5 : 

if  (  column!  5  ]  »=  *\t'  ) 
tab (  1  ) ; 

else 

1 

yyunput!  column!  5  J  ); 
if  (  column!  5  1  ==  '\n'  ) 
yylineno++; 

1 

abort_4 : 

if  (  column!  4  1  =*  ' \t'  ) 
tab(  2  ) ; 

else 

{ 

yyunput!  column!  4  ]  ); 
if  (  column!  4  ]  ==  *\n'  ) 
yylineno++; 

) 


abort_3 : 

if  (  column!  3  1  ==  • \t '  ) 
tab!  3  ) ; 

else 

( 

yyunput!  column!  3  J  ); 
if  (  column!  3  1  ==  '\n'  ) 
yylineno++; 

1 

abort_2 : 

if  (  column!  2  I  ==  '\t'  ) 
tab (  4  ) ; 

else 

( 

yyunput!  column!  2  ]  ); 
if  (  column!  2  1  ==  '\n'  ) 
yy 1 ineno++ ; 
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( 

aborc_l : 

if  (  column!  1  ]  -=  ' \t '  ) 
tab (  5  )  ; 

else 

i 

yyunput (  column!  1  ]  ); 
if  (  column!  1  1  ==  '  \n*  ) 
yylineno++; 

> 

abort_0 : 

if  (  column!  0  )  ==  '\t'  ) 
tab (  6  ) ; 
el  se 

( 

yyunput!  column!  0  ]  ); 
if  (  column!  0  1  ==  '\n'  ) 
yylineno++; 

> 


return (  c  ) ; 
)  /*  yygetc  */ 


FILE:  structure/library/yywrap. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


int  yywrap!  ) 

< 

return (  1  ) ; 
)  /*  yywrap  */ 


FILE:  structure/scanner. 1 


%( 

/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


») 

%a 

10000 

%e 

10000 

%)c 

10000 

%n 

10000 

%o 

10000 

%p 

10000 

a 

CaAl 

b 

[bB] 

c 

[CC1 

d 

[dDl 

e 

teE] 

f 

[fF] 

g 

[gel 

h 

[  hH  ] 

i 

[ill 

j 

[jJl 

k 

tkK) 

1 

[1L] 

m 

[mMl 

n 

CnNI 

o 

[oO] 

P 

CpP) 

q 

[qQl 
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r  trR) 
s  tsSj 
t  C  t  T  i 
u  [uU] 
v  [  vV) 
w  (wWJ 
x  (xXl 

y  (yYl 
z  tzLl 


%( 

♦include  "grammar. h" 
extern  char  "yylval; 


♦  unde  f  YYLMAX 
♦define  YYLMAX  (256'20) 


extern  char  "duplicate!  ); 
extern  char  "hollerith;  ) ; 
extern  char  *non_blar.x  !  )  ; 
extern  char  "lowercase!  ); 


%% 


" [\*cC) . * [\n]  I 
'[\  1  *  [\n]  ( 

♦ifdef  DEBUG 
ECHO; 

♦endi f 

yylval  =  duplicate!  yytext  ); 
return!  COMMENT  ); 

1 


t\  1  < 

♦ifdef  DEBUG 
ECHO; 

♦  enai  f 

/*  return!  ' \  '  )  */; 

) 


(\sl  ( 

♦ifdef  DEBUG 
ECHO; 

♦  endi  f 

return  (  ' \ i '  ) ; 

) 


[\u 

♦ifdef  DEBUG 
ECHO; 

♦endi f 

return  (  '  \  ( '  )  ; 

) 


t\>  )  l 
♦ifdef  DEBUG 
ECHO; 

♦  endi  f 

return (  ' \) '  ) ; 
I 


[\*  1  f 
♦ifdef  DEBUG 
ECHO; 

♦endi f 

return  (  '  \*  ’  )  ; 

} 


[\*I [\*1 


( 
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#i fdef  DEBUG 
ECHO; 

Itendi f 

return (  EXPONENTIATE  ); 
I 


[\+l  ( 

#1 fdef  DEBUG 
ECHO; 

#endi f 

return  (  '  \+ ’  )  ; 

I 


[\,  1  ( 
it  i  fdef  DEBUG 
ECHO; 

#endi f 

return  (  ’ '  )  ; 

} 


(\-l  < 

itifdef  DEBUG 
ECHO; 

Itendi  f 

return  (  ' \- '  ) ; 

1 


[\ -  1  ( 

#i fdef  DEBUG 
ECHO; 

#endi f 

return  (  '  \  ’  )  ; 

) 


[\/l  1 

iifdef  DEBUG 
ECHO; 
tlendi  f 

return (  ' \/ '  ) ; 

1 


IN:  1  ( 

Itifdef  DEBUG 
ECHO; 

#endi f 

return (  '  \  '  )  ; 

1 


[\  =  ]  ( 
ii fdef  DEBUG 
ECHO; 

(tendi  f 

return  (  '  \= '  ) ; 

) 


[\n]  ( 

Itifdef  DEBUG 
ECHO; 

Itendi  f 

/ *  return (  ' \n ’  )  * / ; 


[NtJ  { 

It  i  fde  f  DEBUG 
ECHO; 

"endi f 

/*  return (  ' \t '  )  */; 

i 


[  \  .  If  a  M  n  K  d  )  (  \  .  I  I 
# i fde  f  DEBUG 
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ECHO; 

#endi f 

return!  RW_AND  ); 

1 


[\.](eHq)[\.l  ( 
lifdef  DEBUG 
ECHO; 

#endi f 

return!  RW_EQ  ); 

} 


[\.l(e)(q)(v)[\.l  { 

li fdef  DEBUG 
ECHO; 
lendi f 

return!  RW_EQV  ); 

) 


[\.l  (flfaHlHsHe!  [\ .  ]  { 

lifdef  DEBUG 
ECHO; 
lendi f 

return  (  RW_FALSE  ) ; 

1 


[\.]|gl(e)l\.l  ! 
lifdef  DEBUG 
ECHO; 
lendi f 

return  (  RW_GE  )  ; 

1 


[\.](g>ft>[\.]  ( 
lifdef  DEBUG 
ECHO; 
len  ■‘If 

return  (  RW_GT  ) ; 

1 


t\.)  flHel  [\.l  ( 
lifdef  DEBUG 
ECHO; 
lendi  f 

return!  RW_LE  ); 

1 


[\.](l)(t)[\.J  ( 
lifdef  DEBUG 
ECHO; 
lendi  f 

return (  RW_LT  ) ; 

I 


[\.lfn}{e)[\.]  ( 
lifdef  DEBUG 
ECHO; 
lendi f 

return!  RW_NE  ); 

) 


[\. ] (n)(e; (q||v| (\. ]  { 

lifdef  DEBUG 
ECHO; 
lendi f 

return!  RW_NEQV  ); 

) 


[\.||nHo|(t|(\.|  ! 

lifdef  DEBUG 
ECHO; 


420 


Annual  Report:  Digital  Emulation  Technology  Laboratory  Volume  1,  Part  2 


lendi  f 
1 


return (  RW  NOT  )  ; 


c\ - 1  loiin t\.i  i 

lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_0R  ) ; 

1 


[\.)|t|(r)(ul(e)[\.l  ( 

lifdef  DEBUG 
ECHO; 
lendi  f 

return  (  RW_TRUE  ) ; 

1 


{a){sHs)(iHg)(n>  ( 
lifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_ASSIGN  ) ; 

} 


(bl(a}(c|(ltl  (sHplIaXclfel  ( 
lifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_BACKSPACE  ) ; 

1 


(bl(lKoHcHk)  [\  l*(d|(a|(t|(a|  { 

lifdef  DEBUG 
ECHO; 
lendi f 

return (  RW_8LOCK  DATA  ); 

1 


(clUHIMll  ( 
lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_CALL  ) ; 

1 


(c|(hHaKrHaHc)(t!(e|(r)  ! 
lifdef  DEBUG 
ECHO; 
lendi f 

return (  RW_CHARACTER  ); 

1 


(cHUIoHsHel  { 
lifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_CLOSE  ) ; 

1 


(c) {o( (m) (m) (o) (n(  ( 
lifdef  DEBUG 
ECHO; 
lendi  f 

return!  RW_COMMON  ); 

} 


( c ) ( o) (m) (p) ( 1 ) (e(  i x>  f 
lifdef  DEBUG 
ECHO; 
lendi f 
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return (  RW_COMPLEX  ); 

1 


|cHo)lnKtHilln)(u)(e)  { 

#i  fdef  DEBUG 
ECHO; 

#endif 

return  (  RW_CONTINUE  ) ; 

) 


(dllaHtlla)  { 
t i fdef  DEBUG 
ECHO; 

#endif 

return  (  RW_DATA  ) ; 

} 


(d)(iHmHel(n|(s)UHoHti)  ( 
#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_DIMENSION  ); 


(d){o)  ( 

lifdef  DEBUG 
ECHO; 

#endi f 

return (  RW_DO  ) ; 

) 


(d)  (oHullblillle)  [\  1  *  (pH  r)(e )  (c)<  i  H  s}(  i  )(ol(n)  ( 

(tifdef  DEBUG 
ECHO; 

#endif 

return (  RW_DOUBLE  PRECISION  ); 

) 


(elill(sMe)  { 

# i fdef  DEBUG 
ECHO; 

#endi f 

return (  RW_ELSE  ); 

1 


(eHlHsHe)  [\  ]*(i)(f)  ( 

(tifdef  DEBUG 
ECHO; 

Kendif 

return (  RW_ELSE_IF  ) ; 

) 


(e)(n)(dl  ( 

# i fdef  DEBUG 
ECHO; 
lendif 

return  (  RW_END  ) ; 

) 


(ellnMdl  [\  { 

#ifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_END_IF  ); 

) 


(e)(n)fd)(f){il(l)(e)  ( 

#ifdef  DEBUG 
ECHO; 

(tendi  f 


return)  RW_ENDFILE  ); 
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1 


(e>(n}{t){r)(yl  { 

lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_ENTRY  ) ; 

) 


lellqlluHlllvUaKUieUnHcKe)  1 
lifdef  DEBUG 
ECHO; 

#endif 

return  (  RW_EQU I VALENCE  ) ; 

) 


lellxlltllellrllnlUlU)  ( 
lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_EXTERNAL  ) ; 

} 


(f)|oMr|[«llaKt).*  { 

#ifdef  DEBUG 
ECHO; 

#endif 

yylval  »  duplicate (  yytext  ); 
return (  RW_FORMAT  ); 

1 


tflluHnHcHtl(iHoHn)  { 

# ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_FUNCTION  ); 

1 


(g)fo) [\  ]*(t){o)  { 

#ifde£  DEBUG 
ECHO; 

#endi £ 

return  (  RW_GO_TO  ); 

) 


# ifdef  DEBUG 
ECHO; 
lendif 

return (  RW_IF  ) ; 

) 


(iHm|(p|(ll(l){c)(i)(t)  { 

lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_IMPLICIT  ); 

1 


(il|n||cl(l||u|(d|(e!  ( 

lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_INCLUDE  ) ; 

1 


(lHnl{q}(u)|il(rHe)  ( 
lifdef  DEBUG 
ECHO: 

lendif 

return!  RW  INQUIRE  ); 
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} 


(  i) (n) { t } {e( (g) (e) { r)  ( 
tifdef  DEBUG 
ECHO; 

#endif 

return (  RW_INTEGER  ) ; 

) 


Ulin|{tKr)|iHn)|s)|iKc)  ( 
(tifdef  DEBUG 
ECHO; 

#endif 

return (  RW_INTRINSIC  ); 

} 


(1}  (oHgHiHcHaHll  ( 
(tifdef  DEBUG 
ECHO; 

Itendi f 

return (  RW_LOGICAL  ) ; 

) 


(n|(a)(iti|(e)(lKi|(sKtl  { 
#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_NAMELIST  ); 

} 


(oKpHeHn)  { 

#ifdef  DEBUG 
ECHO; 
lendif 

return (  RW_OPEN  ); 

> 


fp!(a!(rHa)|iB|(e|(t]|e)(r)  { 

Ufdef  DEBUG 
ECHO; 

#endif 

return  (  RW_PARAMETER  ); 


lpl(a) (u) (s) (e>  ( 

(tifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_PAUSE  ); 

) 


lp)|r)(i)(nl{t!  { 

#i fdef  DEBUG 
ECHO; 

Oendi f 

return!  RW_PRINT  ); 

) 


(pi  ! r ) (o) (g) { r } (at (m)  ( 

#ifdef  DEBUG 
ECHO; 

(tendi  f 

return!  RW_PROGRAM  ); 

) 


lr)|el(a)|d|  ( 

(tifdef  DEBUG 
ECHO; 
lendi  f 

return!  RW_READ  >; 

) 
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(r)(eHal(l|  ( 
tifdef  DEBUG 
ECHO; 
tendi f 

return  (  RW_REAL  ) ; 

1 


( r |{e) { t 1 { u ) ( r ( { n )  ( 

(tifdef  DEBUG 
ECHO; 

#endif 

return (  RW_R£TURN  ); 

} 


(r) (e) (w) { i } {n)(d)  ( 
tifdef  DEBUG 
ECHO; 
tendif 

return (  RW_REWIND 

> 


fsHaHvHe)  { 
tifdef  DEBUG 
ECHO; 
tendi f 

return (  RW_SAVE  ) ; 

1 


(s)lt)(o)(pl  ( 
tifdef  DEBUG 
ECHO; 
tendif 

return  (  RW_STOP  ) ; 

1 


(s)(uHb)lr)ioHu)tt)liHn)le)  ( 
tifdef  DEBUG 
ECHO; 
tendif 

return  (  RW_SUBROUTINE  ) ; 

) 


(tl(hHe)ln)  ( 
tifdef  DEBUG 
ECHO; 
tendif 

return  (  RW_THEN  ); 

1 


{ t } { o>  ( 
tifdef  DEBUG 
ECHO; 
tendif 

return)  RWTO  ); 

1 


<w) {r)(i) (t) (e)  ( 

tifdef  DEBUG 
ECHO; 
tendi f 

return (  RWJaRITE  ); 

) 


|uHn)(d|le)(f)(i)(n)(eKd)  { 

tifdef  DEBUG 
ECHO; 
tendi f 

return (  RW  UNDEFINED  ); 
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[%a-zA-Z] [_a-zA-Z0-9] *  ( 

I i fdef  DEBUG 
ECHO; 
lendif 

yylval  =  duplicate (  lowercase!  yytext  )  ); 
return!  IDENTIFIER  ); 

) 


* [0-9  ] [0-9  ] [0-9  ] [ 0-9  ] [0-9  ] [\  ]  { 

#ifdef  DEBUG 
ECHO; 

#endi  f 

yylval  »  duplicate!  non_blank(  yytext  )  >; 
return (  LABEL  ) ; 

} 


[0-9]+  | 

[0-91 +/\ . [a-zA-Z ] +  \  .  ( 

lifdef  DEBUG 
ECHO; 
lendif 

yylval  =  duplicate!  yytext  ); 
return (  INTEGER  ) ; 

) 


[0-9)+\. [0-9] *  < [eE]  [\  +  \-] ? [0-9]+) ?  I 
(0-91 *\. [0-91+ <[eE] [\+\-l? [0-91+)?  I 
[0-91  +  ( [eE]  [\+\-l ? [0-9]+) ?  ( 
lifdef  DEBUG 
ECHO; 

#endi  f 

yylval  =  duplicate!  yytext  ); 
return (  REAL  ) ; 

) 


[0-9]+\. [0-9]*  <[dD]  [\  +  \-l 7(0-91+) ?  I 
[0-9] *\. [0-9) + ( [dD] [\+\-l ? [0-9] +) ?  i 
[0-9]  +  ( [dD]  [\  +  \-l ?[0-9]+) ?  { 
lifdef  DEBUG 
ECHO; 
lendif 

yylval  *=  duplicate!  yytext  ); 
return!  DOUBLE_PRECISION  ); 

) 


\'['\']*\'  I 
\"[*\"1*\"  [ 
lifdef  DEBUG 
ECHO; 
lendi f 

yytext [  0  ]  =  • 

yytext [  strlen!  yytext  )  -  1  ]  =  'V"; 
yylval  =  duplicate!  yytext  ); 
return (  STRING  ) ; 

) 


[0-9] + [hH[  { 
lifdef  DEBUG 
ECHO; 
lendi f 

yylval  =  duplicate!  hollerith!  yytext,  '\H'  )  ); 

return!  HOLLERITH  ); 

) 
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18.  Appendix  M:  usage  program  source 

FILE:  usage/combine/Makef ile 


♦ 

♦  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

♦  Author:  Stephen  R.  Wachtel 

* 


default:  combine 


CC  =>  cc  -g 
INCLUDE  -  include 
CFLAGS  =•  -1$  (INCLUDE) 
LIBRARY  -  library/library .a 


combine. o:  combine. c 

S (CC)  $ (CFLAGS)  -C  combine. c 


combine:  combine. o  $ (LIBRARY) 

S (CC)  -o  combine  combine. o  5 (LIBRARY) 


clean: 

cd  library;  make  clean 
rm  -f  combine  combine. o 


FILE:  usage/combine/combine. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  "table. h" 
♦include  "list.h" 


extern  char  'parse <  ); 


void  input_list(  processor_number,  file_name  ) 
register  int  processor_number; 
register  char  'file  name; 

( 

register  FILE  'file; 

char  identifier!  256  ]; 

char  usage; 

if  (  (  file  =>  fopen (  file_name,  ”r”  )  )  --  (FILE  *)NULL  ) 

(  fprintf (  stderr,  "ERROR:  unable  to  open  for  read  •%s'\n",  file_name  ) 
exit (  -1  ) ; 

( 

while  (  f scanf (  file,  "%s  %c\n",  identifier,  Susage  )  ==  2  ) 
add  list(  identifier  )->usage[  processor_number  ]  =  usage; 

fclose (  file  ) ; 

)  /*  input_list  */ 


int  network_transfer (  usage  ) 
register  char  'usage; 

( 


register  int  s  =  0; 
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register  int  r  =  0; 

while  (  "usage  !=  '\0‘  ) 

( 

switch  (  "usage  ) 

( 

case  'S': 
s++; 
break; 

case  1 R' : 
r+  +  ; 
break; 

) 

usage++; 

) 

return (  {  s  >  1  )  ||  (  (  s  ==  1  )  ss  (  r  !=  0  )  )  ); 

(  /*  network  transfer  */ 


int  length_list<  list  ) 
register  LIST  "list; 

{ 

register  int  length  =  0; 
register  TABLE  "table; 

while  (‘list  !=  (LIST  *)NULL  ) 

{ 

if  (  network  transfer!  list->usage  )  !=  0  ) 

( 

if  (  (  table  -  find_table (  list->identifier  )  )  ==  (TABLE  *)NULL  ) 

{ 

fprintf(  stderr,  "ERROR:  '%s*  not  found  in  table\n",  list->identif ier  ) 
exit  (  -1  ) ; 

1 

length  +=  length  subscript  list(  table->subscript  list  ); 

1 

1 i 3t  »  list->next; 

) 

return!  length  ); 

}  /*  length_list  */ 


void  output_variable (  file,  identifier,  type,  subscript_list,  usage  ) 

register  FILE  "file; 

register  char  "identifier; 

register  char  "type; 

register  char  *subscript_list; 

register  char  "usage; 

( 

char  "subscript; 
int  lower(  2  ); 
int  upper!  2  ); 
int  index!  2  j; 


if  (  (  subscript 
( 

lower!  0  ]  * 
upper!  0  j  = 

> 

else 

( 

lower!  0  1  = 
upper!  0  1  = 


=  parse!  subscript_list  )  ) 


0; 

0; 


atoi (  parse!  subscript  )  ); 
atoi (  parse!  subscript  )  ); 


if  (  (  subscript 

( 

lower!  1  ]  = 
upper!  1  1  = 

) 

else 

( 

lower!  1  1  = 
upper!  1  1  = 


=  parse!  subscript_list 


0; 

0; 


atoi!  parse!  subscript  ) 
atoi!  parse!  subscript  ' 


)  ) 


)  ; 
)  ; 


(char  * ) NULL  ) 


(char  *)NULL  ) 
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if  (  (  subscript  =  parse!  subscript_list  !  )  !=  (char  "(NULL  ) 

{ 

fprintf(  stderr,  "ERROR:  output_variable (  %s  )\n",  identifier  ); 
exit (  -1  ) ; 

1 

if  (  (  lower!  0  ]  !=  0  )  SS  (  upper!  01  !=  0  )  ) 

( 

index!  0  1  =  lower!  0  1; 

while  (  index!  0  ]  <=  upper!  0  1  ) 

( 

if  (  (  lower!  11  !=  0  )  SS  (  upper!  1  j  !=  0  )  ) 

{ 

index!  1  ]  =  lower!  1  ] ; 

while  <  index!  1  ]  <=  upper!  1  )  ) 

( 

fprintf(  file,  “%s (%0'd, %G*a)  %s  %s\n",  identifier,  digit (  upper!  0  i 
),  index!  0  ),  digit!  upper!  11),  index!  1  1,  type,  usage  ); 
index!  1  1++; 

} 

1 

else 

( 

fprintf!  file,  ”%s(%0*d)  %s  %s\n“,  identifier,  digit!  upper!  0  ]  ),  index! 
Q  1 ,  type,  usage  ) ; 

1 

index!  0  ] ++; 


1 

else 

fprintf!  file,  "%s  ts  %s\n”,  identifier,  type,  usage  ) ; 
)  /*  output_variable  */ 


void  output_list (  file  ) 
register  FILE  "file; 

( 

register  TABLE  "table; 

fprintf!  file,  ”%d\n",  length_list(  list  )  ); 

while  (  list  !=  (LIST  *)NULL  ) 

{ 

if  (  network  transfer!  list->usage  )  !  <*  0  ) 

( 

if  (  (  table  =  find_table(  list->identifier  )  )  ==  (TABLE  * ) NULL  ) 

( 

fprintf!  stderr,  "ERROR:  '%s'  not  found  in  tablein",  list->identif ier  ); 
exit  (  -1  )  ; 

1 

output_variable (  file,  1 ist->ident i f ier,  table->type,  table->subscript_list, 
list->usage  ) ; 

1 

list  =  list->next; 

1 

1  /*  output_list  */ 


Ddefine  PROGRAM  argument!  0  1 

♦define  ARGUMENT  argument!  argument_number  1 


int  main!  number_argument ,  argument  ) 
register  int  number_argument; 
register  char  "argument!  ); 

( 

register  int  argument_number  =  0; 
int  processor_number; 
char  file_name[  256  1  ; 

if  (  — number_argument  ==  0  ) 

( 

fprintf!  stderr,  "usage:  %s  00=<file  name> . . . 31=< f i le  name>\n",  PROGRAM  ) ; 
exit!  0  ) ; 

1 

while  (  argument_number++  !=  numbe r_a rgument  ) 

( 
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if  (  sscanf (  ARGUMENT,  "%d=%s“,  Sprocessor  number,  file  name 

( 

fprintf(  stderr,  “ERROR:  unable  to  parse  argument  '%s'\n", 
exit (  -1  ) ; 

) 

input_list(  processor_number,  file_name  ); 

) 

initialize_table (  stdin  ); 
output_list(  stdout  ); 

exit  (  0  ) ; 

}  /*  main  */ 


FILE :  usage /combine/ include/ list .  h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦define  LIST  struct  Iist_type 
LIST 
{ 

char  “identifier; 
char  “usage; 

LIST  “next; 

); 


extern  LIST 
extern  LIST 
extern  LIST 
extern  LIST 


*end_list(  ); 
*add_end_list (  )  ; 
*add_list (  )  ; 
*find_list(  ); 


extern  LIST  “list; 


FILE:  u sage/ combi ne/ i nclude/ t able. h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

“  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦define  TABLE  struct  table_type 
TABLE 
( 

char  “identifier; 
char  “type; 
char  *subscript_iist; 
int  class; 

>; 


extern  void  allocate_table (  ); 
extern  void  input_table  (  ); 
extern  int  compare!  ); 
extern  void  sort_table(  ); 
extern  void  initialize_table (  ); 
extern  TABLE  “find  table!  ); 


extern  TABLE  “table; 
extern  int  number  table; 


)  !=  2  ) 

ARGUMENT  ) ; 
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♦ 

♦  Copyright  1991 

♦  Georgia  Institute  of  Technology 

♦  Computer  Engineering  Research  Laboratory 

♦  Author:  Stephen  R.  Wachtel 

♦ 


CC  -  cc  -g 
INCLUDE  *  ../include 
CFLAGS  =  -1$ (INCLUDE) 
LIBRARY  =  library. a 


OBJECTS  =  \ 
digit. o  \ 
duplicate. o  \ 
length  subscript_list . o  \ 
lin)c_lXst.o  \ 
parse. o  \ 
table .  o 


$ (LIBRARY) : S (OBJECTS) 
rm  -f  $ (LIBRARY) 
ar  crv  $ (LIBRARY)  $ (OBJECTS) 
ranlib  $ (LIBRARY) 


.SUFFIXES:  .c  .o 
•  c.  o: 

$(CC)  -c  $  (CFLAGS)  $< 


clean: 

rm  -f  $ (LIBRARY)  S (OBJECTS) 
FILE:  usage/combine/library/digit . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

V 


int  digit (  number  ) 
register  int  number; 

( 

register  int  count  =  0; 

do 

( 

number  /=  10; 
count++; 

)  while  (  number  !=  0  ); 

return!  count  ); 

)  /*  digit  */ 


FILE:  usage/combine/library/dupl icate . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


((include  <stdio.h> 
♦include  <string.h> 
♦include  <malloc.h> 


char  'duplicate!  string  ) 
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register  char  'string; 

( 

register  char  'temporary  =  (char  ’(NULL; 

if  (  string  !=  (char  '(NULL  ) 

( 

if  (  (  temporary  =  (char  *)malloc(  strlent  string  )  +  1  )  )  !=  (char 

strcpy(  temporary,  string  ); 

else 

fprintfl  stderr,  "ERROR:  duplicate (  %r  )\n",  string  ); 

1 

return (  temporary  ) ; 

}  /'  duplicate  */ 


FILE:  usage/combine/library/Iength  subscript_l ist . c 


/* 

'  Copyright  1991 

'  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

'/ 


extern  char  'duplicate  (  ); 
extern  char  'parse  i  )  ; 


int  length_subscript_list (  subscript_l ist  ) 
register  char  *subscript_list; 

( 

register  char  'subscript; 
register  int  lower; 
register  int  upper; 
register  int  length  =  1; 

subscript_list  =  duplicate (  subscript_list  ); 

while  (  (  subscript  =  parse (  subscript_l ist  )  )  !=  0  ) 

( 

lower  =  atoi(  parse (  subscript  )  ); 
upper  =  atoi  (  parse (  subscript  )  ); 
length  (  upper  -  lower  +  1  ) ; 

1 

return (  length  ); 

)  /*  length_subscript_list  '/ 


FILE:  usage/combine/library/li  ,k_list.c 


/* 

*  Copyright  1991 

'  Georgia  Institute  of  Technology 
'  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 
((include  <malloc.h> 
♦include  <string.h> 
♦include  "list.h" 


extern  char  'duplicate!  ); 


LIST  'list  *  (LIST  * ) NULI ; 


LIST  *end_list(  list  ) 
register  LIST  'list; 

( 

if  (  list  ! =  (LIST  '(NULL  ) 

( 

while  (  1 i st ->next  !=  (LIST  '(NULL  ) 


'  )  NULL  ) 
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list  =  iist.->next; 

) 

return (  list  ) ; 

)  / '  end  list  '/ 


LIST  *add_end_list (  list,  identifier,  usage  ) 
register  LIST  "list; 
register  char  'identifier; 
register  char  'usage; 

( 

register  LIST  'temporary  =  (LIST  *)malloc(  sizeof(  LIST  )  ); 

temporary->identifier  =  duplicate!  identifier  >; 

temporary->usage  =  duplicate (  usage  ); 

temporary->next  =  (LIST  '1NULL; 

if  (  'list  ==  (LIST  ' ) NULL  ) 

'list  =  temporary; 

else 

end_list (  'list  ) ->next  =  temporary; 

return(  temporary  ); 

!  /*  add  end  list  '/ 


LIST  'add_list<  identifier  ) 
register  char  'identifier; 
f 

register  LIST  'temporary  =  find_list (  list,  icantifier  ); 

if  (  temporary  »=  (LIST  *)NULL  ) 

temporary  =  aad_end_l i st (  Slist,  identifier,  " - 

return)  temporary  ); 

)  /'  add_list  '/ 


LIST  *find_list(  list,  identifier  ) 

regi  ;r  LIST  'list; 

regi:  „er  char  'identifier; 

( 

while  (  list  !=  (LIST  ')N(JLL  ) 

( 

if  (  strcmp(  list->identi fier,  .dentifier  )  ==  0  ) 
return (  list  ) ; 

list  *  list->next; 
t 

return (  (LIST  *)NULL  ); 
l  /'  find  list  */ 


FILE :  u sage / combi ne/ 1 i bra ry / parse  .  c 


/* 

*  Copyright  1991 

'  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
'  Author:  Stephen  R.  Wach-el 

*/ 


iinciude  <string.h> 


e.-tern  char  'duplicate!  ); 


cha r  'pa i se  (  list  ) 
register  ehar  'list; 

i 

register  int  lengti  =  0; 

register  int  brace  =  0; 

register  char  'temporary  =  (era:  *)I; 

for  ( ; ; ) 

( 
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switch  (  list[  length  )  ) 

.  { 

case  ' { ' : 

brace++; 

break; 

case  ' 1 ' : 

brace — ; 
break; 

) 


if  (  brace  ==  0  ) 
break; 

length++; 

} 

if  (  length  !=  0  ) 

{ 

list[  length  )  =  '\0'; 
temporary  =  duplicate!  list  +  1  ); 
strcpy!  list,  list  +  1  +  length  ); 

) 

else 

< 

if  (  list!  length  J  !=  ‘\0*  J 

1 

temporary  =  duplicate!  list  ); 
list(  length  ]  =  1  \0'; 

) 

) 

return!  temporary  ); 

)  /*  parse  */ 


FILE:  usage /combi ne/library/t able . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <malloc.h> 
♦include  <string.h> 
♦include  "table. h" 


extern  char  ‘duplicate!  ); 

TABLE  ‘table  »  (TABLE  *)NULL; 
int  number  table  =•  0; 


void  allocate_table (  ) 

< 

if  (  (  table  =  (TABLE  ‘Jmalloc!  sizeof (  TABLE  )  *  number_tabie  )  )  ==  (TABLE 

( 

fprintf!  stderr,  "ERROR:  unable  to  allocate  'table'Xn"  ); 
exit!  -1  ) ; 

\ 

f  /*  allocate  table  */ 


void  input_table(  file  ) 
register  FILE  ‘file; 


int  table__number; 

char  identifier!  256  ]; 

char  type  [  256  ] ; 

char  subscr i pt_l i st [  256  j; 

int  class; 


for  (  table_number  = 

( 


table  number 


number  table;  table  nurber**  ) 


*  )  NULL  ) 


0; 
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if  (  fscanf  (  file,  "%s  %s  %s  %x\n“,  identifier,  type,  subscript_l i st ,  sclass  ) 
4  ) 

{ 

fprintft  stderr,  "ERROR:  unable  to  read  'tablet  %s  ]'\n“,  table_number  ); 
exit)  -1  )  ; 

) 

tablet  table_number  1. identifier  =  duplicate (  identifier  ); 
tablet  table_number  l.type  =  duplicate!  type  ); 

tablet  table_number  ] . subscript_list  *■  duplicate!  subscript_l i st  ); 
tablet  table_number  j. class  =  class; 

} 

)  /*  input_table  */ 


int  compare!  tablel,  table2  ) 

TABLE  ’tablel; 

TABLE  *table2; 

t 

return!  strcmp!  tablel->identif ier,  table2->identif ier  )  ); 
)  /*  compare  */ 


void  sort_table(  ) 

{ 

qsort (  table,  number_table,  sizeof (  TABLE  |,  compare  ); 
)  /*  sort  table  */ 


void  initialize_table (  file  ) 
register  FILE  ’file; 

( 

fscanf!  file,  “%d\n",  Snumber_table  ); 
allocate_table (  ); 
input_table(  file  ); 
sort_table(  ); 

}  /*  initialize  table  */ 


TABLE  *find_table(  identifier  ) 
register  char  ’identifier; 

( 

register  int  low,  high; 
register  int  middle,  test; 

low  »  0; 

high  =  number_table  -  1; 

while  (  low  <=  high  ) 

t 

middle  =  !  low  +  high  )  /  2; 

test  =  strcmp!  identifier,  tablet  middle  ). identifier  ); 

if  (  test  <  0  ) 

( 

high  =  middle  -  1; 
continue; 

) 

if  (  test  >  0  ) 

< 

low  =  middle  +  1; 
continue; 

) 

return!  Stable!  middle  ]  ); 

} 

return!  (TABLE  *)NULL  ); 
t  '*  find  table  */ 


FILE:  usage/sequence/Makefile 


# 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 
It  Author:  Stephen  R.  Wachtel 

I 
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default:  sequence 


CC  =  cc  -g 
INCLUDE  =  include 
CFLAGS  -1$  (INCLUDE) 
LIBRARY  =  library/library .a 


sequence . o : sequence . c 

S (CC)  $ (CFLAGS)  -c  sequence. c 

sequence:  sequence. o  $ (LIBRARY) 

$(CC)  -o  sequence  sequence. o  $ (LIBRARY) 


clean: 

cd  library;  make  clean 
rm  -f  sequence  sequence. o 


FILE :  usage/ sequence/ include /table . h 


/* 

'  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
'  Author:  Stephen  R.  Wachtel 

'/ 


#define  TABLE  struct  table_type 
TABLE 
{ 

char  'identifier; 
char  'type; 
char  'usage; 

}  ; 


extern  void  allocate_table (  ); 
extern  void  input_table(  ); 
extern  int  compare!  ); 
extern  void  sort_table (  ); 
extern  void  initialize  table)  ); 


extern  TABLE  'table; 
extern  int  number  table; 


FILE:  usage/ sequence/ library /Make f i le 


* 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

» 


CC  =  cc  -g 
INCLUDE  =  ../include 
CFLAGS  -  -IS (INCLUDE) 
LIBRARY  =  library. a 


OBJECTS  «  \ 
count. o  \ 
duplicate. o  \ 
message_type . o  \ 
table. o  \ 
type_length .  o 


S (LIBRARY) : S (OBJECTS) 

ar  crv  S (LIBRARY)  S (OBJECTS) 
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ranlib  $ (LIBRARY) 


•SUFFIXES:  .c  .o 
.  c.  o : 

$<CC)  -c  $  (CFLAGS)  $< 


clean: 

rm  -f  S (LIBRARY)  $ (OBJECTS) 


FILE:  usage /sequence /library /count . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
'/ 


int  count!  string,  length,  c  ) 
register  char  'string; 
register  int  length; 
register  char  c; 

( 

register  int  c_count  =  0; 

while  (  length  !=  0  ) 

( 

if  (  'string  ==  c  ) 
c_count+*; 

string**; 

length — ; 

) 


return)  c  count  ); 
)  /'  count  '/" 


FILE:  usage / sequence /libr ary /dupli cat e. c 


/' 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 
((include  <string.h> 
♦include  <malloc.h> 


char  'duplicate (  string  ) 
register  char  'string; 

{ 

register  char  'temporary  *  (char  *)NULL; 

if  (  string  !-  (char  *)NULL  ) 

( 

if  (  (  temporary  =  (char  ')malloc(  strlen(  string  )  +  1  )  )  !=  (char  '(NULL 
strcpy(  temporary,  string  ); 

else 

fprintf(  stderr,  "ERROR:  duplicate!  %s  )\n",  string  ); 

) 

return!  temporary  >; 

)  /*  duplicate  */ 


FILE:  usage/ sequence/ 1 ibrary/message_type . c 


/' 
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*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  A.  Wachtel 

*/ 


♦include  <stdio.h> 


char  *message_type (  type  ) 
register  char  *type; 

( 

int  length; 

if  (  sscant (  type,  “CHARACTER* %d",  Slength 
return!  "CHARACTER_08BIT"  ) ; 

if  (  sscanf (  type,  "COMPLEX* %d",  slength  ) 

( 

switch  (  length  ) 

< 

case  8: 

return!  "COMPLEX_32BIT"  ); 
case  16: 

return!  "COMPLEX_64BIT"  ); 

) 


if  (  sscanf!  type,  "INTEGER* %d",  slength  ) 
{ 

switch  (  length  ) 

( 

case  1: 

return!  "SIGNED_08BIT"  ); 
case  2: 

return!  "SIGNED_16BIT“  ); 
case  4: 

return!  "SIGNED  32BIT"  ); 

) 


) 

if 

{ 


(  sscanf!  type,  "LOGICAL*%d",  slength  ) 

switch  (  length  ) 

( 

case  1: 

return!  "LOGICAL_08BIT"  )  ; 
case  2: 

return!  "L0GICAL_1 6BIT"  ); 
case  4: 

return!  "LOGICAL_32BIT"  ); 

1 


)  = 


if 

( 


) 


(  sscanf!  type,  "REAL*%dn ,  Slength 

switch  (  length  ) 
f 

case  4: 

return!  "REAL_32BIT"  )  ; 
case  8: 

return!  "REAL_64BIT"  ); 

) 


1  ) 


fprintf!  stderr,  "ERROR:  message  type!  %s  ) \n", 
exit!  -1  ); 

)  /*  message_type  */ 


FILE :  usage/ sequence/ 1 ibrary/ table . c 
/» 


1  ) 

) 


> 


) 


type  )  ; 
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*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


linclude  <stdio.h> 
linclude  <malloc.h> 
linclude  <string.h> 
linclude  "table. h" 


extern  char  "duplicate (  ); 


TABLE  "table  =  (TABLE  *)NULL; 
int  number  table  =  0; 


void  allocate_table (  ) 

( 

if  (  (  table  =  (TABLE  *)malloc(  sizeof<  TABLE  )  *  number_table  )  )  ==  (TABLE  *)NULL  ) 

( 

fprintf(  stderr,  "ERROR:  unable  to  allocate  ’table'Vn"  ); 
exit (  -1  ) ; 

) 

}  /*  allocate  table  */ 


void  input_table(  file  ) 
register  FILE  "file; 

{ 

register  int  table  number; 
char  identifier!  256  ]; 
char  type[  256  J; 
char  usage!  256  J; 

for  (  table_number  =  0;  table_number  !=  number  table;  table_number++  ) 

( 

if  (  fscanff  file,  "»s  %s  %s\n“,  identifier,  type,  usage  )  !=  3  ) 

( 

fprintfl  stderr,  "ERROR:  unable  to  read  'table!  %d  ]'\n",  table_number  ); 
exit (  -1  ) ; 

) 

table!  table_number  ]. identifier  =  duplicate (  identifier  ); 
table!  table_number  j . type  =  duplicate!  type  ); 
table!  tablenumber  j .usage  =  duplicate!  usage  ); 

1 

)  /*  input_table  */ 


int  compare!  tablel,  table2  ) 
register  TABLE  "tablel; 
register  TABLE  *table2; 

( 

register  int  temporary  =  count!  tablel->usage,  strlen!  tablel->usage  ),  )  -  count! 

table2->usage,  strlen!  table2->usage  ),  ); 

if  (  temporary  !=  0  ) 
return!  temporary  ) ; 

else 

return!  strcmp!  tablel->identifier,  table2->identifier  )  ); 

}  /*  compare  »/ 


void  sort  table!  ) 

( 

qsort (  table,  number_table,  sizeof!  TABLE  ),  compare  ); 
)  /*  sort  table  */ 


void  initialize  table!  file  ) 
register  FILE  *?ile; 

( 

fscanf!  file,  "%d\n",  snumber_table  ); 
al locate_table (  ); 
input_table(  file  ); 
sort_table (  )  ; 
i  /*  initialize  table  */ 
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FILE:  usage/ sequence/ 1 ibrary / t ype_length. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 


int  type_length(  type  ) 
register  char  "type; 

{ 

char  name (256); 
static  int  length; 

if  (  sscanf (  type,  "%[*»] *%d",  name,  Slength  )  ==  2  > 
return (  length  ) ; 

else 

return (  0  ) ; 

)  /*  type_length  */ 


FILE:  usage /sequence/ sequence,  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 
♦include  <malloc.h> 
♦include  <string.h> 
♦include  "table. h" 


extern  char  "duplicate (  ); 
extern  char  *message_type  (  ); 


♦define  NUMBER_PROCESSOR  32 

char  *file_name[  NUMBER_PROCESSOR  ); 

static  int  cycle  «  0; 


int  next_sender(  last_sender,  usage  ) 
register  int  last_sender; 
register  char  "usage; 

{ 

register  int  processor_number  =  last_sender; 

while  (  usage[  ++processor_number  ]  !=  '\0'  ) 

( 

if  (  usage!  processor_number  )  ==  'S'  ) 
return!  processor_number  ); 

) 

return!  -1  )  ; 

)  /*  next  sender  */ 


int  next_receiver (  last_receiver,  usage  ) 
register  int  last_receiver; 
register  char  "usage; 

( 

register  int  processor_number  =  last_recei ver; 

while  (  usage!  ++processor_number  ]  [-  '\0'  ) 

{ 

if  (  usage!  processor_number  ’  ==  ' 


R*  ) 
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return)  processor_number  ); 

1 

return (  -1  ) ; 

)  /*  next  receiver  */ 


void  send  processor)  sender,  identifier,  type  ) 
register  Tnt  sender; 
register  char  ‘identifier; 
register  char  “type; 

{ 

register  FILE  ‘file; 

if  (  (  file  =  fopen)  file_name[  sender  ),  "a"  )  )  ==  (FILE  *)NULL  ) 

{ 

fprintf)  stderr,  "ERROR:  unable  to  open  for  update  '%s'\n“,  file_name[  sender  ]  ) 
exit)  -1  ) ; 

1 

fprintf)  file,  "*  CYCLE  [  %d  ]\n",  cycle  >; 

fprintf)  file,  ”\tCALL  SEND_%s ( % s ) \n“,  message_type (  type  ),  identifier  ); 

fclose (  file  ) ; 

)  /*  send_processor  */ 


void  receive_processor (  receiver,  identifier,  type  ) 
register  int  receiver; 
register  char  ‘identifier; 
register  char  ‘type; 

{ 

register  FILE  ‘file; 

if  (  (  file  -  fopen)  filename)  receiver  1,  “a"  )  )  •»  (FILE  *)NULL  ) 

( 

fprintf)  stderr,  "ERROR:  unable  to  open  for  update  '%s'\n",  file  name)  receiver  ) 

)  ; 

exit)  -1  ) ; 

1 

fprintf)  file,  ■*  CYCLE  [  %d  ) \n",  cycle  >; 

fprintf)  file,  "\tCALL  RECEIVE_%s (%s) \n“,  message  type)  type  ),  identifier  ); 
fclose)  file  );  ~ 

)  /*  receive_processor  »/ 


void  output_transfer (  file,  table  ) 
register  FILE  ‘file; 
register  TABLE  ‘table; 

< 

register  int  sender; 
register  int  receiver; 
register  char  delimeter; 

if  (  count)  table->usage,  strlen)  table->usage  ),  'S'  )  >  1  ) 

) 

fprintf)  stderr,  "ERROR:  %s,  %s,  %s\n",  table->identi f ier,  table->type,  table 

>usage  ) ; 

exit (  -1  ) ; 

1 

sender  =*  -1; 

while  (  (  sender  *  next_sender(  sender,  table->usage  )  )  !=  -1  ) 

{ 

delimeter  <*  *  '; 
receiver  «  -1; 

while  (  (  receiver  =  next  receiver)  receiver,  table->usage  )  )  !=  -1  ) 

) 

receive_processor (  receiver,  table->identi f ier,  table->type  ) ; 
fprintf)  file,  "%c  p%02d",  delimeter,  receiver  ); 

delimeter  =  ' , ' ; 

} 

send_processor (  sender,  table->identi f ier,  table->type  ); 

fprintf)  file,  “  :=  p%02d.%d;  [  %s  %s  !\n",  sender,  type_length(  table->type  )  / 
2,  table->type,  table->identifier  ); 

) 
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table->usage  =  (char  ‘(NULL; 
}  /*  output_transfer  */ 


int  and_usage (  usagel,  usage2  ) 
register  char  ‘usagel; 
register  char  *usage2; 

( 

register  int  processor_number  =  0; 

while  (  (  usagel [  processor  number  ]  !*  1  \0'  )  ££  (  usage2[  processor  number  !  !=  ' \ 0 ' 

)  ) 

( 

if  (  (  usagel [  processor_number  )  !=  )  ss  (  usage2[  processor_number  ]  != 

)  ) 

return (1); 
processor_number++ ; 

) 

return (  0  )  ; 

}  /*  and_usage  */ 


char  *or_usage (  usagel,  usage2  ) 
register  char  ‘usagel; 
register  char  *usage2; 

( 

register  int  processor_number  =  0; 
char  buffer!  256  ]; 

while  (  (  usagel!  processor  number  ]  !=  '\0‘  )  ss  (  usage2[  processor_number  ]  !=  ■\0' 

)  ) 

( 

if  (  (  usagel!  processor  number  ]  ==  )  ss  (  usage2[  processor  number  ]  != 

)  ) 

buffer!  processor_number  ]  =  usage2 [  processor_number  ); 
else 

buffer!  processor_number  ]  =  usagel!  processor_number  ]; 
processor_number++; 

1 

buffer!  processor_number  ]  =  '\0'; 

return)  duplicate!  buffer  )  ); 

)  /*  or_usage  */ 


void  output_cycle (  file,  table_number  ) 
register  FILE  ‘file; 
register  int  table_number; 
f 

register  char  ‘usage; 

if  (  table!  table_number  ]. usage  !=  (char  ‘(NULL  ) 

1 

fprintf (  file,  "CYCLE  [  %d  J \n",  ++cycle  ); 

usage  -  duplicate)  table!  table_number  ) .usage  I; 
output_transfer (  file,  stable!  table_number  ]  ); 

while  (  ++table_number  !=  number_table  ) 

( 

if  (  table!  table_number  ] .usage  !=  (char  *)NULL  ) 

I 

if  (  and_usage (  usage,  table!  table_number  ]. usage  )  ==  0  ) 
( 

usage  *  or_usage(  usage,  table!  table_number  ! .usage  ); 
output_transfer (  file.  Stable!  table  number  ]  ); 

) 

> 

) 


fprintf)  file,  "\n"  ); 

} 

}  /*  output_cycle  */ 


void  output_table (  file  ) 
register  FILE  ‘file; 

( 
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register  int  table_number; 

fprintf!  file,  "LOOPNn"  ); 
fprintf (  file,  ”\n"  ); 

for  (  table_number  =  0;  table_number  !=  number_table;  table_number++  ) 
output_cycle (  file,  table_number,  number_table  ); 

}  /*  output_table  '/ 


♦define  PROGRAM  argument!  0  ) 

♦define  ARGUMENT  argument!  argument_number  1 


int  main!  number_argument,  argument  ) 
register  int  number_argument; 
register  char  'argument!  1; 

! 

register  int  argument_number  »  0; 
int  processor  number; 
char  name!  25?  ); 

if  (  — number_argument  =«  0  ) 

{ 

fprintf!  stderr,  "usage:  %s  00=<file  name>. . . 31=<file  name>\n",  PROGRAM  ) 
exit (  0  )  ; 

1 

while  (  argument_number++  !=  number_argument  ) 

( 

if  (  sscanf!  ARGUMENT,  "%d=%s“,  4processor_number,  name  )  !=  2  ) 

{ 

fprintf!  stderr,  "ERROR:  unable  to  scan  argument  ‘%s'\n",  ARGUMENT  )  ; 
exit (  -1  > ; 

1 

strepy!  index!  name,  ),  ■■  .inc"  )  ; 

file_namet  processor_number  1  =  duplicate!  name  )  ; 

unlink!  file_name(  processor_number  }  ) ; 

1 

initialize  table!  stdin  ); 
output_tabTe (  stdout  )  ; 

exit!  0  ); 

1  /*  main  •/ 


FILE:  usage/summary /Makef ile 


♦ 

♦  Copyright  1991 

♦  Georgia  Institute  of  Technology 

♦  Computer  Engineering  Research  Laboratory 

♦  Author:  Stephen  R.  Wachtel 

♦ 


default:  summary 


CC  =■  cc  -g 
INCLUDE  -  include 
CFLAGS  -  -IS (INCLUDE) 
LIBRARY  *  library/library . a 


summary. o:  summary. c 

$ (CC)  S (CFLAGS)  -c  summary. c 

summary:  summary. o  $ (LIBRARY) 

S (CC)  -o  summary  summary.o  $ (LIBRARY) 


clean: 

cd  library;  make  clean 
rm  -f  summary  summary.o 


FILE :  usage /summary/ include/processor . h 
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/' 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Viachtel 
*/ 


♦define  NUMBER  PROCESSOR  32 


♦define  PROCESSOR  struct  processor_type 
PROCESSOR 
< 

char  *file_name; 
int  s; 
int  r; 

}; 


extern  PROCESSOR  processor [  NUMBER_PROCESSOR  ]; 


FILE :  usage/ summary /include /table. h 


/* 

'  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦define  TABLE  struct  table_type 
TABLE 
( 

char  'identifier; 
char  'type; 
char  'usage; 

); 


extern  void  allocate_table (  ); 
extern  void  input_table !  ) ; 
extern  int  compare!  ); 
extern  void  sort  table!  ); 
extern  void  initialize  table!  ); 


extern  TABLE  'table; 
extern  int  number_table; 


FILE:  u sage /summary /library /Make file 


♦ 

♦  Copyright  1991 

♦  Georgia  Institute  of  Technology 

♦  Computer  Engineering  Research  L?boratory 

♦  Author:  Stephen  R.  Wachtel 

♦ 


CC  ”  cc  -g 
INCLUDE  =•  ../include 
CFLAGS  =  -IS (INCLUDE) 
LIBRARY  =  library. a 


OBJECTS  =  \ 
count. o  \ 
duplicate. o  \ 
table,  o 


S (LIBRARY) : S (OBJECTS) 

ar  crv  $ (LIBRARY)  S (OBJECTS) 
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ranlib  S (LIBRARY) 


.SUFFIXES:  .c  .o 
.c.o: 

$(CC)  -c  $ (CFLAGS)  S< 


clean: 

rm  -f  $ (LIBRARY)  $ (OBJECTS) 


FILE:  usage/summary/library/count . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


int  count (  string,  length,  c  ) 
register  char  ’string; 
register  int  length; 
register  char  c; 

{ 

register  int  c_count  =  0; 

while  (  length  !=  0  ) 

{ 

if  (  ’string  ==  c  ) 
c_count++; 

string++; 

length — ; 

1 

return!  c  count  ); 

)  /*  count  */~ 


FILE:  usage / summary /libr a ry / dupl i ca t e. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:-  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  <malloc.h> 


char  ’duplicate (  string  ) 
register  char  ’string; 

{ 

register  char  ’temporary  =  (char  *)NULL; 

if  (  string  .' =  (char  *)NULL  ) 

( 

if  (  (  temporary  =  (char  *)malloc(  strlenl  string  )  +  1  )  )  !=  (char  *)NULL 

strcpyl  temporary,  string  ); 

else 

fprintf(  stder  ,  "ERROR:  duplicate!  %s  )\n“,  string  ); 

) 

return!  temporary  ); 

)  /*  duplicate  */ 


FILE:  u sage / summa ry /I ibr ary /table . c 


/* 

*  Copyright  1991 
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*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 
((include  <malloc.h> 
((include  <string.h> 
♦include  "table. h" 


extern  char  'duplicate (  ); 


TABLE  'table  =  (TABLE  *)NULL; 
int  number_table  =  0; 


void  allc  ate_table(  ) 

( 

if  (  (  table  =  (TABLE  *)malloc(  sizeof(  TABLE  )  '  number  table  )  ,  ==  (TABLE  * ) NULL  ) 

( 

fprint'1  stderr,  "ERROR:  unable  to  allocate  ’table'Xn"  ); 
exit  (  -1  ) ; 

1 

}  /*  allocate_table  '/ 


void  input_table(  file  ) 
register  FILE  'file; 

{ 

register  int  table_number; 
char  identifier(  256  ]; 
char  type[  256  ]; 
char  usage [  256  ); 

for  (  table_number  =  0;  table  number  !=  number  table;  table  number++  ) 

(  -  _ 

if  (  fscanf (  file,  "%s  %s  *s\n”,  identifier,  type,  usage  )  !=  3  ) 

! 

fprintfl  stderr,  "ERROR:  unable  to  read  ’tablet  %d  )’\n",  table  number  ); 
exit (  -1  ) ; 

) 

tablet  table_number  ). identifier  =  duplicate!  identifier  ); 
tablet  table_number  l.type  =  duplicate!  type  ); 
tablet  table_number  ] .usage  =  duplicate!  usage  ); 

) 

}  /*  input_table  '/ 


int  compare!  table!,  table2  ) 

TABLE  'tablel ; 

TABLE  *table2; 

( 

return!  strcmp!  tablel->identi fier,  table2->identi f ier  )  ); 
)  /*  compare  */ 


void  sort_table(  ) 
f 

gsort (  table,  number_table,  sizeof!  TABLE  ),  compare  ); 
)  /*  3ort_table  */ 


void  initialize_table (  file  ) 
register  FILE  'file; 

t 

fscanf!  file,  "td\n”,  Snumber_table  ); 
allocate_table (  ); 
input_table(  file  ); 
sort_table (  ) ; 
t  /*  initialize_table  '/ 


FILE:  usage/summary/summary .  c 


/' 


Copyright  1991 
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*  Georgia  Institute  o£  Technology 

»  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 
♦include  <malloc.h> 
♦include  <string.h> 
♦include  "table. h” 
♦include  "processor . h" 


extern  char  "duplicate)  ); 


PROCESSOR  processor [  NUMBER_PROCF.SSOR  ]; 


void  initialize_processor (  ) 

( 

register  int  processor_number; 

for  (  processor_number  =  0;  processor_number  !=  NUMBER^PROCESSQR;  processor_number+* 

{ 

processor!  processor_number  ) . f ile_name  =  (char  "(NULL; 
processor!  processor_number  ].s  =  0; 
processor!  processor_number  J.r  -  0; 

} 

)  /*  initialize_processor  */ 


void  output_header (  file,  usage  ) 
register  FILE  "file; 
register  char  "usage; 

( 

register  int  processor_number  =  0; 
static  page_number  ■  0; 

if  (  ++page_number  !=  1  ) 
fprintfl"  file,  “\f"  ); 

fprintf(  ile,  "Page  »2d  I”,  page_number  ); 

while  (  usage!  processor_number  J  !«  'NO'  ) 

{ 

fprintf(  file,  "P%02d|",  orocessor_number  ); 
processor_number  +  + ; 

1 


fprintfl  file,  "\n"  ); 
(  /*  output_header  */ 


void  output_divider (  file,  usage  ) 
register  FILE  "file; 
register  char  "usage; 

( 

register  int  processor_number  -  0; 

fprintfl  file,  " - +  "  ); 

while  (  usage!  processor_number  1  !=  'NO*  ) 

{ 

fprintfl  file,  " - *"  ); 

processor_nunber“; 

1 

fprintfl  file,  "\n"  ); 

}  /*  output_di vider  */ 


void  output_t rans f er  I  file,  table  ) 
register  FILE  "file; 
register  TABLE  "tabie; 

( 

register  int  processor_numbei  0; 

fprintfl  file,  "%-16s  %-16s  t  jwe->ider,tif.er,  table->type  )  ; 
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while  (  table->usage [  processor_number  1  !=  '\0'  ) 

< 

if  (  table->usage (  processor_number  )  ==  ) 

fprintf (file,  "  I "  ) ; 

else 

< 

fprintf (  file,  ”  %c  i",  table->usage [  processor_number 

switch  (  table->usage  (  processor_run-.ber  j  ) 

< 


case  'S': 

processor!  processor_nuir\ber  ].s++; 
break; 

case  ' R '  : 

processor!  processor_nuroer  ;.r»  +  ; 
break; 


1 


} 


processor_number++; 

) 


)  ; 


if  (  count (  table->usage,  strlent  table->usage  ),  'S'  )  >  1  ) 

fprintf (  file,  "  WARNING"  ); 

fprintf!  file,  "\n"  ); 

}  /*  output_t ransfer  */ 


void  cutput_tabie (  fi]”  ) 
register  FILE  'file; 
i 

♦define  LINE_NUMBER  64 

register  int  table_nu.nber; 

register  int  line_number  =  LINE_NUMBER; 

for  (  table_number  =  0;  table_number  !=  number_table;  table_number++  ) 

{ 

if  (  1 ine_number  ==  LINE_NUMBER  ) 

( 

line_number  =  0; 

output_header (  file,  tablet  table_number  ). usage  ); 
line_number++; 

output_divider (  file,  tablet  table_number  ]. usage  ); 
line  number++; 

) 

output_transfer (  file,  &table[  tacle_number  1  ); 

1 ine_numbert+; 

output  divider  (  file,  tablet  table_r.un-.ber  ].  usage  ); 

1 ine_numbe  r*+; 

1 

)  /’  output_table  */ 


void  output_processor (  file  ! 
register  FILE  'file; 


register  int  processor_number; 
fprintf!  file,  " \ n ’’  ); 


for  (  processor_number  »  0;  processcr_number  !=  NLM8ER_PR0CESS0R;  processo r_ntr.se r - » 

( 

if  (  processor  [  processor_number  ].file_name  !=  Icnar  '}N'JLL  ) 

( 

strcpy!  index!  processor!  processor_nunoer  ;.file_name,  ),  ".for"  ); 

fprintf!  file,  "p%02d  =  %s",  processor_number,  processor!  processor_nu.tber 
i  .  file_name  )  ; 


proce 


sor 


fprintf (  file, 
fprintf (  file, 
fprintf!  file, 
numbe  r  ’ . r  )  ; 


S  -  %3d",  processor!  Drocessor_number 
R  =  %3d",  processor!  processor_number 
%3d",  processor;  processornumber  !-s 


1  .  s  )  ; 

;  .  r  )  ; 

♦  processor 


fpri nt  f ( 

) 


file,  " \ n "  )  ; 


) 


I 
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}  /*  output_processor  */ 


Idefine  PROGRAM  argument [  0  ) 

#define  ARGUMENT  argument!  argument_number  ] 


int  main(  number_argument ,  argument  ) 
register  int  number_argument; 
register  char  'argument!  ); 

1 

register  int  argument_n  mber  =  0; 
int  processor_number; 
char  fils_name[  256  ]; 

if  (  — number_argument  ==  0  ) 

{ 

fprintf(  stderr,  "usage:  %s  90=<fiie  name> . . . 31=<f ile  name>\n”,  PROGRAM  ) 
exit  (  0  )  ; 

) 


initialize_processor (  ); 

while  (  argument  number++  !=  number_argument  ) 

( 

if  (  sscanf  (  ARGUMENT,  "%d=%s",  &processor_number,  fiie_name  )  =  2  ) 

! 

fprintf!  stderr,  "ERROR:  unable  to  scan  argument  • %s’\n",  ARGUMENT  ); 
exit  (  -1  ) ; 

1 

processor!  processor_number  ].file_name  =  duplicate!  file_name  ); 

1 

initialize_table (  stdin  ) ; 
output_table (  stdout  ); 
output_processor (  stdout  ); 

exit (  0  ) ; 

1  /*  main  */ 


FILE:  usage/type/Makef ile 


* 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 
I  Author:  Stephen  R.  Wachtel 

# 


default:  type 


CC  =  cc  -g 
INCLUDE  *  include 
CFLAGS  =  -IS  (INCLUDE) 

LIBRARY  «  statement/statement . a  1 ibrary / libra ry . a 


OBJECTS  »  \ 

$( INCLUDE) /grammar . h  \ 
•grammar. [col  \ 

*  scanner . [col  \ 
yytrace. [co]  \ 
y . output 


PROGRAMS  =  \ 
•type 


grammar. c:  grammar. y 
yacc  -dv  grammar. y 
mv  y.tab.h  S  (INCLUDE) /grammar. h 
mv  y.tab.c  grammar. c 


scanner. c:  scanner. 1 

lex  -vt  scanner. 1  I  sed  1 s/getc/yyget c/ 1  >scanner.c 


13.  Appendix  M:  usage  program  source 


449 


scanner. o:  scanner. c  $( INCLUDE) /grammar . h 
$( CC)  S(CFLAGS)  -c  scanner. c 

grammar. o:  grammar. c 

$(CC)  $(CFLAGS)  -c  grammar. c 

type:  grammar. o  scanner. o  $ (LIBRARY) 

S (CC)  -o  type  grammar. o  scanner. o  $ (LIBRARY) 


sgrammar . c :  grammar . c  yytoken.awk 

awk  -f  yytoken.awk  <grammar.c  >sgrammar.c 

sgrammar. o: sgrammar. c 

5 (CC)  S(CFLAGS)  -c  sgrammar.c 

stype:  sgrammar. o  scanner. o  $ (LIBRARY) 

$  (CC)  -o  stype  sgrammar. o  scanner. o  S (LIBRARY) 


dscanner.c:  scanner. c 

cp  scanner. c  dscanner.c 

dscanner.o:  dscanner.c  S (INCLUDE) /grammar. h 
5 (CC)  $ (CFLAGS)  -DDEBUG  -c  dscanner.c 

dtype:  grammar. o  dscanner.o  $ (LIBRARY) 

$(CC)  -o  dtype  grammar. o  dscanner.o  $ (LIBRARY) 


tgrammar.  c:  grammar .  c 

sed  ' s/yystack: /S  yytrace (yystate) ; / '  kgrammar.c  >tgrammar.c 

tgrammar. o:  tgrammar. c 

S (CC)  $ (CFLAGS)  -c  tgrammar. c 

ttype:  tgrammar. o  scanner. o  yytrace. o  $ (LIBRARY) 

$ (CC)  -o  ttype  tgrammar. o  scanner. o  yytrace. o  S (LIBRARY) 


yytrace. c:  grammar. c  yytr'ce.awk 

awk  -f  yytrace. awk  <y. output  >yytrace.c 

yytrace. o:  yytrace. c 

$(CC)  S (CFLAGS)  -c  yytrace. c 


clean: 

cd  statement;  make  clean 
cd  library;  make  clean 
rm  -f  S (PROGRAMS)  S (OBJECTS) 


FILE:  usage/type/grammar . y 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*7 


/* 

*  FORTRAN  77 

*/ 


%token  RW_AND 
%token  RW_ASSIGN 
%token  RW_BACKSPACE 
%token  RW_BLOCK_DATA 
%token  RW_CALL 
%token  RW_CHARACTER 
%token  RW_CLOSE 
%token  RW_COMMON 
%token  RW_COMPLEX 
%token  RW  CONTINUE 
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ttoken  RW_DATA 
ttoken  RW_DIM£NSION 
ttoken  RW_DO 

%token  RW_OOUBLE_PR£CISION 

%token  RW_ELSE 

%token  RW_ELSE_IF 

ttoken  RW_END 

ttoken  RW_END_IF 

ttoken  RW_ENDFILE 

ttoken  RW_ENTRY 

ttoken  RW_EQ 

ttoken  RW_EQUI VALENCE 

ttoken  RW_EQV 

ttoken  RW_EXTERNAL 

ttoken  RW_FALSE 

ttoken  RW_FORMAT 

ttoken  RW_FUNCTION 

ttoken  RW_GE 

ttoken  RW_GO_TO 

ttoken  RW_GT 

ttoken  RW_IF 

ttoken  RW_IMPLICIT 

ttoken  RW_INCLUDE 

ttoken  RW_INQUIRE 

ttoken  RW_INTEGER 

ttoken  RW_INTRINSIC 

ttoken  RW_LE 

ttoken  RW_LOGICAL 

ttoken  RW_LT 

ttoken  RW_NAMELIST 

ttoken  RW_NE 

ttoken  RW_NEQV 

ttoken  RW_NOT 

ttoken  RW_0PEN 

ttoken  RW  OR 

ttoken  RW~pARAMETER 

ttoken  RW_PAUSE 

ttoken  RW_PRINT 

ttoken  RW_PROGRAM 

ttoken  RW_READ 

ttoken  RW_REAL 

ttoken  RW~R£TURN 

ttoken  RW_REWIND 

ttoken  RW_SAVE 

ttoken  RW~STOP 

ttoken  RW~SUBROUTINE 

ttoken  RWJTHEN 

ttoken  RW_TO 

ttoken  RW  TRUE 

ttoken  RW'WRITE 

ttoken  RW  UNDEFINED 


ttoken  COMMENT 
ttoken  CONCATENATE 
ttoken  DOUBLE_PRECISION 
ttoken  EXPONENTIATE 
ttoken  HOLLERITH 
ttoken  IDENTIFIER 
ttoken  INTEGER 
ttoken  LABEL 
ttoken  REAL 
ttoken  STRING 


tleft  ' , ' 
tnonassoc  1 : ' 
tright  ’=' 

tleft  RW_EQV  RW_NEQV 
tleft  RW_0R 
tleft  RW_AND 
tleft  RW_NOT 

tnonassoc  RW_EQ  RW_NE  RW_LT  RW_LE  RW_GT  RW_GE 

tleft  CONCATENATE 

tleft  •+• 

tleft  •*’  '/' 

tright  EXPONENTIATE 

tleft  SIGN 


typedef  char  'POINTER; 
♦define  YYSTYPE  POINTER 

extern  POINTER  duplicate!  ); 
extern  POINTER  merge!  ); 
extern  POINTER  type!  ); 

♦include  "list.h" 

♦include  "class. h" 

%> 


%% 


program: 

opt ional_statement  list 
{ 

summary  <  I  ; 

) 


optional  statement_list : 
/*  NULL  */ 

I 

statement  list 


statement_list : 

statement 

I 

statement  list  statement 


statement : 

comment_statement 

I 

label  unlabeled  statement 


comment_statement : 
COMMENT 


label : 

LABEL 


unlabeled_statement : 

include_statement 

I 

program_statement 

I 

block_data_statement 

I 

f unct ion_statement 

I 

subrout ine_st at ement 

I 

ent ry_statement 
I 

end_statement 

I 

spec! f icat ion_statement 
I 

executable_statement 

I 

format  statement 


include_statement : 

RW  INCLUDE  character  constant 


18.  Appendix  M:  usage  program  source 


451 


452 


Annual  Report:  Digital  Emulation  Technology  Laboratory  Volume  1,  Part  2 


program_statement : 

RW_PROGRAM  program_identifier 


program_identif ier : 

IDENTIFIER 


block_data_statement : 

RW  BLOCK  DATA  block  data  identifier 


block_data_identif ier: 
IDENTIFIER 


function_statement : 

RW_FUNCTION  function_identif ier  optional_formal_argument_list 

{ 

function_statemenc (  0,  S2,  $3  ) ; 

} 

I 

type  RW_FUNCTION  function_identif ier  optional_formal_argument  list 

{ 

function_statement (  SI,  $3,  $4  ); 

} 


function_identifier: 

IDENTIFIER 


subroutine_statement : 

RW_SUBROUTINE  sub rout ine_ident i fie r 
I 

RW_SUBROUTINE  aubroutine_identif ier  optional_formal_argument_list 


subrout ine_identi tier : 
IDENTIFIER 


entry_statement : 

RW_ENTRY  entry_identif ier 

I 

RW_ENTRY  entry_identi f ier  optional_formal_argument_list 


entry_identif ier : 

IDENTIFIER 

{ 

SS  =  SI; 

) 


opt ional_f ormal_argument_list : 

{ 

SS  =  0; 

) 

I 

'('  formal  argument_list  ')' 
( 

SS  =  S2; 

> 


f ormal_a  rgument _1 i st : 

formal_argument 
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< 

$  S  =  merge!  "  i  %  s )  " ,  SI  )  ; 

1 


formal_argument  list  1  formal  argument 

( 

$$  -  merge!  "%s{%s}",  $1,  $3  >; 

) 


forma l_argument : 

IDENTIFIER 

< 

SS  =  $1; 

} 

I 

forma l_a rgument_al ternate_return 

( 

$$  =  SI; 

1 


formal_argument_alternate_return : 
»  *  • 

( 

S$  =  duplicate!  ); 

1 


end_statement : 

RW_END 

1 

endstatement (  ) ; 

) 


specification_statement : 

external  statement 

I 

intrinsic_statement 

I 

parameter_statement 

I 

dimens ion_st a tement 
I 

declaration_statement 

I 

save_st a tement 

I 

common_st a tement 
I 

equivalence_st a tement 
I 

implicit_st a tement 

I 

da ta_sta tement 

I 

namelist  statement 


ext ernal_st a tement ; 

RW  EXTERNAL  external  list 


oxternal^list : 

external 


SS  =  merge!  "(%s)”,  SI  ); 

( 

external_l i st  external 

( 

SS  =  merge!  "%s(%sj",  SI,  S3  ); 

) 
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external : 

IDENTIFIER 

< 

$$  =  SI; 

) 


intrinsic_statement ; 

RW  INTRINSIC  intrinsic  list 


intrinsic_list : 

intrinsic 

( 

SS  =  merge!  "(%s)".  Si  ); 

) 

I 

intrinsic_list  intrinsic 

{ 

$$  =  merge!  "%s{%s}*\  SI,  $3  ); 

) 


intrinsic: 

IDENTIFIER 

( 

$$  «  Si; 

) 


parameter_statement : 

RW_PARAMETER  '('  parameter_list  ')' 

{ 

parameter_statement (  S3  ); 

) 


parameter_list : 

parameter 

( 

SS  »  merge!  ”(%s}",  Si  ); 

) 

I 

parameter_list  parameter 

1 

SS  «  merge!  "%s(%s(",  SI,  S3  ); 

) 


parameter: 

IDENTIFIER  1 ■'  expression 

( 

SS  -  merge!  n(%s)(%s)",  $1,  S3  ); 

I 


dimension_statement : 

RW_DIMENSION  dimension_l i st 

( 

dimension_statement (  $2  ) ; 


dimens ion_l 1st : 

dimension 

( 

SS  =  merge!  "(%s)".  Si  ); 

) 


dimension_list  dimension 

( 
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$$  =  merge {  “%s{%s)M,  SI,  $3  ); 

> 


dimension : 

IDENTIFIER  ’ ( * subscript_list  ')' 

( 

$$  -  me rge  (  "(tsHts)",  SI,  S3  ); 

) 


subscript_list : 

subscript 

{ 

S$  »  merge)  "(%sj'',  $1  ); 

} 

I 

subscript_list  subscript 

{ 

S$  -  merge)  "%s{%s}n,  $1,  $3  ); 

) 


subscript : 

upper_bound 

f 

#define  LOWER_BOUND  duplicate)  “1"  ) 

$$  -  merge)  "{%s){*s}",  LOWER_BOUND,  SI  ); 

) 

I 

lower_bound  ' : '  upper_bound 

{ 

$S  -  merge)  "{%s){%s)",  SI,  S3  ); 

1 


l  owe  rebound: 

expression 

{ 

SS  =  SI; 

} 


upper_bound: 

lower_bound 

{ 

SS  =  $1; 

) 

I 

uppe  r_bou  nd_ad  justable 

{ 

SS  =  SI; 

) 


upper_bound_ad justable : 

»  *  * 

( 

SS  =  duplicate)  ); 

I 


declaration_statement : 

type  declaration_list 

{ 

declaration_atatement (  SI,  S2  ); 

) 


declaration_list : 

declaration 

( 

SS  =  merge)  "(%s)”,  SI  ); 
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declaration_list  declaration 

{ 

SS  -  me rge (  ”%s(%s}",  SI,  $3  ); 

) 


declaration: 

IDENTIFIER 

( 

$$  =  merge!  "(%s)",  $1  ); 

) 

I 

IDENTIFIER  •('  subscript_list  ’ ) ' 

{ 

$5  -  merge!  "{»sH%s>’\  SI,  S3  ); 

1 


type: 

type_name  optional_type_length 

{ 

SS  =  type!  SI,  S2  )  ; 

1 


type_name : 

RW_CHARACTER 

( 

SS  =  duplicate!  "CHARACTER"  ); 

) 

I 

RW_COMPLEX 

( 

SS  -  duplicate!  "COMPLEX"  ); 

1 

I 

RW_DOUBLE_PRECISION 

( 

SS  «  duplicate!  "DOUBLE_PRECISION"  ); 

1 

I 

RWINTEGER 

( 

SS  =  duplicate!  "INTEGER"  ); 

1 

I 

RW_LOGICAL 

< 

SS  =  duplicate!  "LOGICAL"  ); 

) 

I 

RW_REAL 

( 

SS  *  duplicate!  "REAL"  >; 

1 

I 

RW_UNDEFINED 

{ 

SS  -  duplicate!  "UNDEFINED"  ); 

) 


optional  type_length: 
F*  NULL  */ 

( 

SS  -  0; 

1 

I 

type  length 

( 

SS  =  SI; 


) 
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type_length : 

INTEGER 

( 

$$  =  S2; 

} 

I 

'*'  type_length_ad justable 

{ 

$$  -  $2; 

) 


type_length_ad justable: 

'  C  ■*'  •)  ' 

( 

SS  =  duplicate!  "-I”  ); 

} 


save_statement : 

RW_SAVE  optional_save_list 


optional  save_list: 
f*  NULL  */ 

{ 

SS  =  0; 

> 

I 

save_list 

{ 

SS  -  SI; 

) 


save_list: 

save 

( 

SS  =  merge!  "(%s)",  SI  ) ; 

) 

I 

save_list  save 

{ 

SS  =  merge!  "%sf%s}’\  SI,  S3  ); 

) 


save : 

IDENTIFIER 

( 

SS  =  SI; 

) 

I 

common_name 

( 

SS  -  SI; 

) 


common_statement : 

RW_COMMON  optional_common_name  common_va r i able_l ist 
( 

common_statement (  S2,  S3  ); 

} 


optional  common_name: 
A*  NULL  */ 

( 

SS  =  0; 

) 

common_name 

( 
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SS  =  SI; 

) 


common_name : 

'/'  optional_identifier 

( 

SS  -  $2; 

} 


optional  identifier: 
/-*  NULL  */ 

{ 

SS  =  0; 

1 

I 

IDENTIFIER 

{ 

SS  -  SI; 

} 


common_variable__li  st : 

common_variable 

{ 

S$  =  merge!  "  (  %  s  l  " ,  SI  ); 

) 

common_variable_list  common_variable 

( 

$  $  m  merge!  "  %  s  {  %  s }  " ,  $ 1 ,  S3  ) ; 

) 


common_variable : 

IDENTIFIER 

! 

SS  =  merge!  "!%s(",  SI  ) ; 

} 

I 

IDENTIFIER  '('  subscript_l i st  ')' 

( 

SS  -  merge!  "{%s)f%s}",  SI,  $3  ); 

) 


equivalence_statement : 

RW  EQUIVALENCE  equivalence_list 


equivalence_list : 

equivalence 

( 

SS  =  merge!  "  (  %  s  (  " ,  SI  ); 

) 

I 

equivalence_list  equivalence 

( 

SS  =  merge!  ”  %  s  {  %  s  (  ” ,  $1,  S3  ); 


equivalence : 

'('  equi valence_variabie_l i st  ‘ )‘ 

( 

SS  =  S2; 

} 


equ i val ence_variable_list: 

equivalence_variable 

( 
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$S  =  merge(  SI  ); 

} 

equivalence_variable_list  equivalence_variable 

SS  =  merge!  ”%s(%s}",  $1,  S3  ); 

1 


equivalence_variable: 

IDENTIFIER 

{ 

SS  =  merge!  SI  ); 

) 

I 

IDENTIFIER  • (•  subscript_iist  1 )' 

( 

SS  =  merge!  " (4s}{%sj",  SI,  $3  ); 

} 


impl icit_statement : 

RW_IMPLICIT  type  '('  implicit_list  ’)* 

{ 

implicit_statement (  S2,  S4  ) ; 

1 


implicit_list: 

implicit 

t 

SS  =  merge!  "{%s)“,  $1  ); 

} 

I 

implicit_list  implicit 

( 

SS  =•  merge!  "%s{%s)H,  $1,  $3  ); 

} 


implicit : 

IDENTIFIER 

( 

SS  =  merge!  SI  ); 

} 

I 

IDENTIFIER  IDENTIFIER 

{ 

SS  »  merge!  ”{»s)(»s)",  SI,  $3  ) ; 

> 


namel i st_statement : 

RW  NAMELIST  namelist  name  namelist  list 


namel i st_name : 

'/’  IDENTIFIER 

( 

SS  =  S2; 

) 


namel ist_list : 

namel ist 

{ 

SS  =  merge!  "(%s)",  SI  ); 

) 

I 

name  1 i st_l i st  namelist 

( 

) 


SS  =  merge!  "%s!%s}",  SI,  S3  )  ; 
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namel ist : 

IDENTIFIER 

{ 

SS  =  SI; 

) 


data_state!rent : 

RW  DATA  data  list 


data_list : 

data 

{ 

$$  -  merge (  "( %s} ",  $1  ) ; 

) 

I 

data  list  optional_comma  data 

( 

SS  -  merge (  "%s(%s)“,  SI,  S3  ); 

) 


data : 

data_variable_list  '/'  data_constant_list  '/' 

( 

SS  =  merge!  «(*sH*s»",  SI,  S3  ); 

) 


data_variable_list : 

data_variable 

( 

SS  =  merge!  "!%sl",  SI  ); 

) 

I 

data_variable_li st  data_var iable 

( 

SS  -  merge!  "%s(%st",  SI  S3  )  ; 

1 


data_variable: 

variable 

( 

SS  =  SI; 

) 

I 

data_impl ied_do_l ist 

( 

SS  =  SI; 

i 


dat a_impl ied_do_l ist: 

’('  data_variable_list  IDENTIFIER  expression_l i st  ')’ 

( 

add_l i st (  0,  St,  0,  0,  IMPLICIT  !  LOCAL  I  VARIABLE  ); 

SS  *  merge!  "(  %s,  %s  -  %s  )",  list!  S2,  ”,  "  ),  St,  list 

) 


data_constant_list: 

data_constar. 

{ 

SS  =  merge!  "!%sj".  Si  ); 

} 

data_constant_i  i  st  '  data_ccr.stant 
t 

S  S  =  merge!  "  %  s  {  %  s  ) 1  ,  SI,  S3  )  ; 

1 


(  S6, 
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data_constant : 

data_initialization 

( 

SS  =  SI; 

} 

I 

IDENTIFIER  data_initi al i zat ion 

{ 

SS  =  merge (  "%s  *  %s",  SI,  S3  ); 

> 

I 

INTEGER  data_initialization 

i 

SS  =  merge!  "%s  *  %s",  SI,  S3  )  ; 


da ta_ Initialization: 
IDENTIFIER 
{ 

SS  =  SI; 

1 

I 

character_constant 

i 

SS  =  SI; 


Iogical_constant 

{ 

SS  =  SI; 

} 

signed_numerical_constant 

( 

SS  =  SI; 

! 


iigned_numerical_constant : 

numerical_constant 

( 

SS  =  SI; 

1 

I 

'+'  numericai_ccnstant  %prec  SIGN 

I 

SS  *  merge!  "*%s",  $2  >; 

) 

I 

numer i ca i_constant  %prec  SIGN 

( 

SS  =  merge!  ”-%s",  52  ); 


expression: 

parenthesisexpression 
S3  =  SI; 

i 

simple  expression 

! 

SS  -  SI; 


pa: 


nesisfexpression: 

’('  expression  '  l  ' 


$S 


merge ( 
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simple_expression : 

variable 

( 

SS  =  SI; 

} 

I 

constant 

( 

SS  =  SI; 

1 

I 

arithmetic_expression 

{ 

SS  =  SI; 

1 

I 

character_expression 

( 

SS  =  SI; 

1 

t 

relational_expression 

{ 

SS  =  SI; 

} 

I 

logical_expression 

( 

SS  =  SI; 

I 

I 

unary  expression 

( 

SS  -  SI; 

) 


variable : 

IDENTIFIER 

{  add_l 1st (  0,  $1,  0,  0,  IMPLICIT  I  LOCAL  I  VARIABLE  ); 

SS  -  $1; 

1 

I 

IDENTIFIER  st ring_subset 

1  add_list(  0,  SI,  0,  C,  IMPLICIT  I  LOCAL  I  VARIABLE  >; 

S$  =  merge (  "%s%s",  $1,  $2  ); 

) 

I 

array 

( 

SS  -  SI; 

) 


array: 

IDENTIFIER  opt ional_expression_l i st  ’)* 

{ 

if  (  ! array  (  SI  )  ) 

(  add_list (  0,  SI,  0,  0,  IMPLICIT  I  GLOBAL  I  VARIABLE  I  FUNCTION  ) 
SS  =  merge!  "%s(  %s  SI,  list!  S3,  ",  "  )  ); 

1 

IDENTIFIER  '('  optionalexpressionl i st  ')'  st r ing_subset 

! 

if  (  1  array  (SI)) 

add  list i  0,  SI,  0,  0,  IMPLICIT  :  GLOBAL  I  VARIABLE  i  FUNCTION  I 
$$  =  merge!  "%s(  %s  )%s".  Si,  i.st!  SJ.  ",  "  ),  S5  I; 

( 


18.  Appendix  M:  usage  program  source 


463 


opt iona l_expression_l i st : 
/*  NULL  */ 

( 

$$  =  0; 

) 

I 

expression_list 

( 

$$  =  SI; 

) 


express! on_li st : 

expression 

( 

SS  =  merge)  "(%s(",  SI  ); 

1 

expression_l i st  1  expression 

( 

SS  =  merge)  ,,%s(%s}n,  SI,  $3  ); 

1 


string_subset : 

optional_expression  optional_expression 

( 

SS  =  merge)  "  <  %s  :  %s  )",  $2,  S4  ); 

i 


opt ional_expression : 
/*  NULL  */ 
f 

SS  =  0; 

} 

I 

expression 

( 

SS  =  SI; 

1 


constant : 

character_constant 

( 

SS  =  SI; 

1 

i 

logical_constant 

( 

SS  -  SI; 

) 

I 

numerical_constant 

( 

SS  =  SI; 

} 


cha  racter_constant : 
HOLLERITH 
t 

SS  =  SI; 


STRING 

( 

SS  =  SI; 

) 


logical 


constant : 
RW  i ALSE 
{ 
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SS  =  duplicate (  ".FALSE.”  ); 

} 

I 

RW_TRUE 

{ 

$$  »  duplicate (  ".TRUE."  >; 

) 


numerical_constant : 

DOUBLE_PRECISION 

1 

SS  -  SI; 

( 

I 

INTEGER 

( 

SS  -  SI; 

) 

I 

REAL 

1 

SS  =  SI; 

} 


ar ithmet ic_expression : 

expression  ■+'  expression  %prec 
f 

SS  =  merge!  "%s  +  %s",  $1,  $3  ); 

1 

I 

expression  expression  %prec 

( 

SS  =  merge!  "%s  -  %s",  SI,  S3  ); 

1 

I 

expression  1  * '  expression  %prec 

{ 

SS  «  merge!  "%s  *  %s",  SI,  $3  ); 

1 

I 

expression  '/'  expression  %prec  ’/' 

( 

SS  =  merge!  "%s  /  %s",  SI,  $3  ); 

) 

I 

expression  EXPONENTIATE  expression  %prec  EXPONENTIATE 

{ 

SS  =  merge!  "%s  **  %s",  SI,  S3  ); 

} 


character_expression: 

expression  '/'  '/'  expression  %prec  CONCATENATE 

( 

SS  =  merge!  "%s  //  %s",  SI,  S3  )  ; 

) 


relational_expression: 

expression  RW_EQ  expression  %prec  RW_EQ 

< 

SS  =  merge!  "ts  .  EQ.  %s".  Si,  S3  ); 

1 

I 

expression  RW_N£  expression  %prec  RW_NE 
! 

SS  =  merge!  "ts  .NE.  %s",  SI,  S3  ) ; 

I 

expression  RW_LT  expression  %prec  RWLT 
I 

SS  =  merge!  "%s  .LT.  %s",  SI,  S3  ); 
t 

expression  RW_LE  expression  *prec  RW_LE 
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t 

$S  =  merge (  "%s  .LE.  %s",  $1,  S3  ); 

) 

expression  RW_GT  expression  %prec  RW_GT 

{ 

$S  =  merge!  "%s  .GT.  %s",  SI,  S3  ); 

) 

expression  RW_GE  expression  %prec  RW_GE 

( 

$S  =  merge!  ”%s  .GE.  %s",  SI,  S3  ); 

) 


logical^ expression : 

eroression  RW_AND  expression  %prec  RW_AND 

< 

$$  =  merge!  "%s  .AND.  %s",  SI,  S3  ); 

} 

expression  RW_OR  expression  %prec  RW_OR 

( 

SS  =  merge!  "as  .OR.  %s",  SI,  S3  ); 

} 

I 

expression  RW_EQV  expression  %prec  RW_EQV 

{ 

SS  =  merge!  "%s  . EQV.  %s",  SI,  S3  ) ; 

) 

I 

expression  RW_NEQV  expression  %prec  RW_NEQV 

{ 

SS  =  merge!  "%s  . NEQV .  %s",  SI,  $3  ); 

} 


unary_expression : 

'+'  expression  %prec  SIGN 

( 

SS  =  merge!  "  +  %s",  S2  ) 

> 

I 

expression  %prec  SIGN 

< 

SS  =  merge!  "-%s",  S2  ) 

) 

RW_NOT  expression  %prec  RW 

( 

SS  =  merge!  ".NOT.  %s", 

) 


executable_statement : 
do_statement 
[  ~ 

logical_if_statement 

I 

bl ocX_i f _st atement 
I 

else_statement 

e 1 se_i f_statement 

i 

end_i f_staiement 

subset  executable  statement 


do_statement : 

RW_DO  opt i ona 1 _i nteaer  IDENTIFIER  exp;  ,sion_list 

( 

do_ statement <  S2,  S3,  S5  ); 

) 


NOT 
52  )  ; 
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optional  integer: 

/*  NULL  */ 

( 

$$  -  0; 

1 

I 

INTEGER 

( 

$$  =  $1; 

1 


logical_i f_statement : 

if  expression  subset_executable_statement 


if_expression: 

RWIF  ' ('  expression  ■) ' 


b'  ock_if_statenient : 

RW_IF  •('  expression  •)'  RWJTHEN 


else_statement : 

RW  ELSE 


else_i f_statement : 

RW_ELSE_IF  ' ( '  expression  • ) •  RW_THEN 


end_i f_statement : 

RW  END  IF 


subset  executable_stat.ement : 

assignment _statement 

I 

assign_statement 

I 

arithmetic_if_statement 

I 

cont inue_statement 

I 

call_statement 

I 

return_statement 

uncondit ional_go_to_statemunt 
I 

c'imputed_go_to_statement 

I 

assigned_go_to_statement 

I 

stop  stater^nt 

I 

pause_statement 

I 

io  statement 


a ss ignment_statement : 

variable  •»'  expression 


assign_statement : 

RW  ASSIGN  INTEGER  RW  TO  IDENTIFIER 
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arithmet ic_if_statement : 

RW_IF  1 ('  expression  ') 1  integer_list 


continue_stacement : 

RW  CONTINUE 


call_statement: 

RW_CALL  IDENTIFIER 
I 

RW_CALL  IDENTIFIER  optionai_actuai_argu.T.ent_list 


ootional_actual_argument_iist : 

( 

$$  =  0; 

1 

I 

'('  actual_argument  list  ■)' 

( 

$S  =  $2; 

1 


actual_argument_list : 

actual_argument 

( 

$$  =  me rge (  "{»s)H,  SI  ) ; 

1 

i 

actual_argument_list  actual_argument 

( 

$S  -  merge (  "%s{%s)'\  SI,  S3  ) ; 

) 


actual_argument : 

expression 

{ 

SS  =  SI; 

1 

I 

actual_argument_alternate_return 

{ 

SS  -  SI; 

1 


actua la rgument_al ternate_return : 
INTEGER 

( 

SS  =  merge {  "*%sM,  S2  ); 

) 


return_statement : 

RW_RETURN  opt ionai_expres s ion 


uncondi t ional_go_to_statement : 
RW  GO  TO  INTEGER 


computed_go_to_statement : 

RW_GO_TO  '('  integer_list  ')'  optional_comma  expression 


assigned_go_to_statcment : 

RW  GO  TO  IDENTIFIER 
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RW_GO_TO  IDENTIFIER  optional_comma  •{'  integer_list  ■)• 


optional  comma: 

F*  NULL  */ 


integer_list : 

INTEGER 

{ 

SS  =  merge (  " { *s > ”,  $1  1 ; 

) 

I 

integer_list  • ,  •  INTEGER 

( 

$$  -  merge)  “%s(%s}",  SI,  S3  ); 

) 


pause_statement : 

RW_PAUSE  optional_expression 


stop_statement : 

RW_STOP  optional__expression 


io_statement : 

open_statement 

I 

close  statement 

I 

inquire  statement 

I 

read_statement 

I 

write_statement 

I 

print_statement 

I 

backspace_statement 

I 

rewind_statement 

I 

endfile  statement 


open_statement : 

RW  OPEN  '('  cont  ol  information  list  ')' 


close_statement : 

RW  CLOSE  '('  control  information  list  ')' 


i nqul re_statement • 

RW  INQUIRE  '('  Control  information  list 


read_statement • 

RW_READ  '(’  control_information_l ist  ')'  opt ional_ io_l i st 

RW_READ  control 

I 

RW_READ  control  io_list 


write  statement: 
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RW_WRITE  '('  control_information_list  1 )'  optional_io_list 


control 

control  ' , 1  io_list 


backspace_statement : 

RW_BACKSPACE  '('  control_information_list  ')" 
I 

RW  BACKSPACE  control 


rewind_statement : 

RW_REWIND  '('  control_in£ormation_list  *)' 
I 

RW  REWIND  control 


endfile_statement : 

RW_ENDFILE  ■('  control_information_list  ')* 
I 

RW  ENDFILE  control 


control_in format ion_li st : 

control_in format  ion 

{ 

SS  -  merge)  SI  ); 

) 

I 

control_lnformation_list  control_information 

{ 

$$  =>  merge  (  "%s(%s)“,  SI,  S3  ); 


control_information: 

control 

1 

SS  =  SI; 

) 

I 

IDENTIFIER  expression 

( 

SS  =  merge (  "%s  =  %s",  SI,  S3  ) ; 

) 


control : 

variable 

{ 

$$  =  SI; 

} 

I 

constant 

( 

SS  -  SI; 

1 

I 

»  *  I 

( 

SS  *  duplicate)  ); 

) 


print_statement : 

RW_PRINT 

I 

RW  PRINT 


optional  io_list: 

/*  NULL  */ 

( 

SS  -  0; 

) 
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l 

io_list 

{ 

SS  =  $1; 

) 


io_list : 

io 

( 

SS  =  merge (  "{%st",  SI  ) ; 

^  1 

io_list  ' ,  '  io 

{ 

SS  =  merge (  “%s{%sl",  SI,  S3  ); 

) 


io: 

expression 

{ 

SS  -  SI; 

1 

I 

io_implied_do_list 

1 

SS  =  SI; 

1 


io_implied_do_list : 

•  < *  io  list  ■ IDENTIFIER  '  =  '  expression_list 
f 

add_list(  0,  $4,  0,  0,  IMPLICIT  I  LOCAL  I  VARIABLE  ); 

SS  -  me  rge  (  "(  *s,  %s  =  %s  )  ",  list(  $2,  ",  "  ),  S4,  list)  S6,  ",  "  )  ) 

1 


format_statement : 

RW  FORMAT 


%% 


FILE:  usage/type/include/class . h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


(tdef ine  IMPLICIT  0x00 
♦define  EXPLICIT  0x01 

♦define  LOCAL  0x00 
♦define  GLOBAL  0x02 

♦define  VARIABLE  0x00 
♦define  CONSTANT  0x04 

♦define  ARRAY  0x10 
♦define  FUNCTION  0x20 


FILE:  usage/type/include/1 ist . h 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 
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*  Computer  Engineering  Research  Laboratory 

*  Author;  Stephen  R.  Wachtel 

*/ 


#define  LIST  struct  list_type 
LIST 

{ 

char  ‘structure; 
char  ‘identifier; 
char  ‘type; 
char  ‘list; 
int  class; 

LIST  ‘next; 

)  ; 


extern 

LIST 

‘end  list  (  ) ; 

extern 

LIST 

*add_end_list i 

extern 

LIST 

‘find  list (  ) ; 

extern 

void 

add_list(  ); 

extern 

int 

length  list (  )  ; 

extern 

void 

print_class(  ) 

extern 

void 

print_list (  ) ; 

extern 

LIST 

*  list  ; 

FILE;  usage/ type/ library /Make file 


# 

t  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


CC  =  cc  -g 

INCLUDE  »  ../include 
CFLAGS  =  -IS (INCLUDE) 
LIBRARY  »  library. a 


OBJECTS  =  \ 
array. o  \ 
count. o  \ 
duplicate. o  \ 
hollerith.o  \ 
implicit. o  \ 
link_list.o  \ 
list . o  \ 
main.o  \ 
merge. o  \ 
non_blank.o  \ 
parse. o  \ 
summary. o  \ 
type.o  \ 
uppercase. o  \ 
yyerror.o  \ 
yygetc.o  \ 
yywrap . o 


S (LIBRARY) :  S (OBJECTS) 

ar  crv  S (LIBRARY)  $  (OBJECTS) 
ranlib  $ (LIBRARY) 


•SUFFIXES:  .c  .o 
.  c .  o: 

S(CC>  -c  S (CFLAGS)  S< 


clean : 

rm  -f  S (LIBRARY)  S (OBJECTS) 


FILE:  usage/type/ 1 ibrary/array . c 
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/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

»/ 


((include  <stdio.h> 
((include  "list.h” 
((include  "class. h” 


int  array(  identifier  ) 
register  char  "identifier; 

( 

register  LIST  "temporary  =  find_list(  _iist_,  identifier  ); 

if  (  temporary  !=  (LIST  "(NULL  ) 

return)  (  temporary->ciass  &  ARRAY  I  ==  ARRAY  ); 

else 

return (  0  )  ; 

}  /'  array  */ 


FILE:  usage/type/library/count . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


int  count (  string,  length,  c  ) 
register  char  "string; 
register  int  length; 
register  char  c; 

( 

register  int  c_count  =  u; 

while  (  length  !=  0  ) 

( 

if  (  "string  ==  c  ) 
c_count++; 

st  ri ng  +  +  ; 

iength--; 

) 

return)  c_count  ); 

>  /’  count  */ 


FILE:  usage/ type/ library /duplicate. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 
((include  <string.h> 
•include  <malloc.h> 


char  "duplicate)  string  ) 
register  char  "string; 

i 

register  char  "temporary  *  (char  "INL’LL; 

if  (  string  ’=  (char  "(NULL  ) 

( 
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if  !  (  temporary  =  (char  ’)malloc<  strlenl  string  )  +  1  )  )  !=  (char 

strcpyf  temporary,  string  )  ; 

else 

fprintfl  stderr,  "ERROR:  duplicate!  %s  )\n",  string  ); 


return (  temporary  ); 
1  /*  duplicate  */ 


FILE :  usage/ type /library /holler ith . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  K.  Wachtel 

*/ 


((include  <stdio.h> 


char  *hollerith(  string,  delimeter  ) 
register  char  "string; 
register  char  delimeter; 

( 

int  hollerith_length; 

register  int  string_length  =  0; 

sscanf (  string,  "%dh",  shollerith_length  ); 

string!  string_length++  !  =  delimeter; 

while  (  hollerith  length  !=  0  ) 

( 

if  (  (  string!  string_length  1  »  yyinput (  )  )  ==  ' \n‘  ) 

( 

yyunput (  string!  string_length  !  ); 
break; 

) 

string_length++; 
holler i th_ length- -; 

) 

string!  string_lengtht+  )  =  delimeter; 

string!  st ring_length  }  =  '\0‘; 

return (  string  )  ; 

}  /*  hollerith  */ 


FILE :  usage /type/ 1 ibrary/ implicit . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern 

char  *def ault_integer 

extern 

char  "default  logical 

extern 

char  "duplicate (  ); 

static 

i 

char  *implicit_table [ 

/• 

A 

*/  o. 

/* 

8 

*/  0, 

/* 

C 

*/  o, 

/* 

D 

*/  o. 

/* 

E 

*/  o. 

/* 

F 

*/  0, 

/* 

G 

*/  o. 

/* 

H 

*/  0, 

/* 

I 

*/  o. 

/* 

J 

*/  o. 

/* 

K 

*/  o. 

•(NULL  ) 
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/*  L 
/*  M 
/*  N 
/*  0 
/*  P 
/*  Q 
/*  R 
/*  S 
/.  T 

/*  u 

/*  V 

/*  w 

/*  X 
/*  Y 

/*  z 

/*  ? 


*/  0, 
*/  0, 
'/  0, 
*/  0, 
*/  0, 
’/  o, 
*/  0, 
*/  o, 
*/  0, 
*/  0, 
*/  o, 
*/  0, 
*/  0, 
*/  0, 
*/  0, 


*/  "UNDEFINED1' 


♦  define  IMPLICIT_TABLE  (  sizeof!  imp! i ci t_t able  )  /  sizeof!  char  *  )  ) 


int  offset  (  c  ) 
reqister  char  *c; 

t 

♦  define  LOWER  CASE (  c)  (  <  c  >-  ' a '  >  Si  (  c  <»  '  z '  )  ) 
if  (  LOWER_CASE<  c[  0  ]  )  ) 
return (  c[  0  )  -  ’a’  ); 

♦define  UPPER  CASE (  c  )  (  (  c  ' A'  )  SS  (  c  <-  ’ Z '  )  ) 
if  (  UPPERCASE  (  c[  0  1  )  ) 
return  (  c [  0  )  -  ' A '  ) ; 

return (  IMPLICIT_TABLE  -  1  )  ; 
i  /*  offset  */ 


char  *implicit_type (  string  ) 
register  char  "string; 

{ 

return!  duplicate!  implicit_tab!e [  offset!  string  )  )  )  ); 

I  /*  impl  icit__type  */ 


void  type_impl icit (  string,  lower_bcuna,  upper_bound  ) 
register  char  "string; 
register  char  *  lower_b  -jund; 
register  char  *upper_bound; 

( 

register  int  index; 

if  (  upper_bound  ==  0  ) 

upper_bound  =  lower_bour.d; 

for  (  index  =  offset!  lower_bound  );  ;r.dex  <=  offset!  upper  bound  I;  index" 
implicit_tabie [  index  1  =  string; 

!  /*  type_impl icit  */ 


void  implicit  initialize!  ) 

j 

typ«  _implicit  (  "REAL'4",  "A",  "li"  )  ; 
type_impl icit (  defaui ■ _intege  ",  "I”,  “S“  i; 

t ype_ impl  i ci  t  (  "REAL  4",  "C",  ’Z”  ); 

)  /*  imp i  i c i  t _i n i  t  i a  1  i ze  •/ 


file::  usage/type/  I  ibrary/1  i  i  st .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Tech  r.c . oqy 

*  Computer  Eng mee ring  Re  sear  oh  Laoorat o*y 

*  Author:  Stephen.  ? .  Wachte. 

*  / 


•include  <sts_io.h> 

•  include  <?r,a  lloc.h> 
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H include  " list.h" 
iinclude  "class. h 


extern  char  "duplicate (  ); 
extern  char  * impl ici t_t ype (  ); 


LIST  *_1 i  st_  =  (LIST  * ) NULL; 

idefine  ZERO (  a,  b  )  (  (  a  !=  Z  )  ?  a  :  b  ) 


LIST  *end_list(  list  ) 
register  LIST  “list; 

{ 

if  (  list  ! =  (LIST  * ) NULL  ) 

while  (  iist->r.ext  (  =  (LIST  "(NULL  ! 
list  =  list->next; 

) 

return (  list  )  ; 

(  /*  end  list  */ 


LIST  "add_end  iist(  list,  identifier  ) 
register  LIST  "’list; 
register  char  "identifier; 

{ 

register  LIST  "temporary  =  (LIST  "Imalloct  sizeofl  LIST  )  ); 

temporary->structure  =  (char  "(NULL; 
temporary->identif ier  =  identifier; 
temporary->type  «  (char  "(NULL; 
temporary->list  =  (char  "(NULL; 
temporary->class  =  0; 
temporary->next  =  (LIST  "(NULL; 

if  (  "list  ==  (LIST  * ) NULL  ) 

"list  =  temporary; 

else 

end_list(  "list  ) ->next  =  temporary; 

return!  temporary  ); 

)  /*  add_end_list  */ 


LIST  *find_llst(  list,  identifier  ) 
register  LIST  "list; 
register  char  "identify  er; 

( 

while  (  list  !=  (LIST  "(NULL  ) 

1 

if  (  strcmp(  list->identif ier,  identifier  (  ==  0  > 
return (  list  )  ; 

list  =  list->next; 

) 

return (  (LIST  "(NULL  (  ; 

(  /*  find_list  */ 


void  add_list(  structure,  identifier,  type,  list,  class  ) 

register  char  "structure; 

register  char  "identifier; 

register  char  "type; 

register  char  "list; 

register  int  class; 

register  LIST  "temporary  =  find_List(  _list  ,  identifier  ); 

if  (  temporary  ==  (LIST  "(NULL  ) 

temporary  =  add_end_l i st (  s_list_,  identifier  ); 

if  (  (  class  t  (  IMPLICIT  1  EXPLICIT  )  )  =  =»  EXPLICIT  ) 

temporary->type  *  type; 

else 

temporary->type  =  ZERO)  temporary- >type,  i mp I . c i t _t ype ( 

tempo ra ry-> st ructure  =  ZERO!  tempora ry->st ruct ure,  structure  ) ; 


i dent . 1 ;er  (  )  ; 
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temporarv->lisc  =  ZERO  I  tertporary->l:st,  list  ); 

temporary ->cl ass  1=  class; 

)  /'  idd_list  */ 


int  length_list(  list  ) 
register  LIST  ‘list; 

{ 

register  int  length  =  0; 

while  (  list  !=  (LIST  '(NULL  ) 

f 

length"; 

list  =  list->next; 

; 

return (  length  ); 

1  /'  length_list  '/ 


void  print_class (  file,  class  ) 
register  FILE  'file; 
register  int  class; 

( 


# i fde  f 

DEBUG 

if 

(  (  class 

&  (  IMPLICIT  1  EXPLICIT  ) 

)  ==  EXPLICIT 

fprint  f ( 

file,  "  EXPLICIT"  ) ; 

else 

fprintf ( 

file,  "  IMPLICIT"  ); 

if 

(  (  class 

&  (  LOCAL  1  GLOBAL  )  )  == 

GLOBAL  ) 

fprintf  ( 

file,  "  GLOBAL"  ); 

else 

fprint  f ( 

file,  »  LOCAL"  ); 

if 

(  (  class 

i  (  CONSTANT  1  VARIABLE  ) 

)  ==  CONSTANT 

fprintf ( 

file,  "  CONSTANT"  ); 

else 

fprintf  ( 

file,  "  VARIABLE"  ); 

if 

(  (  class 

S  ARRAY  )  ==  ARRAY  ) 

fprintf ( 

file,  "  ARRAY"  ); 

if 

(  (  class 

S  FUNCTION  )  =-=  FUNCTION  J 

i 

fprintf ( 

file,  "  FUNCTION"  ) ; 

#else 

fprintfl  file,  "  %x”,  class  ); 
#endi f 

1  /*  print_ciass  '/ 


void  print_list(  file,  list  ) 
register  FILE  'file; 
register  LIST  'list; 

( 

while  (  list  !=  (LIST  *)NULL  ) 

( 

fprintfl  file,  "%s  %s  %s",  list->identif ier,  ZERO!  list->type, 
ZERO (  list->list,  "((01(0))"  )  ); 

print_class(  file,  list->class  ); 

fprintfl  file,  "\n"  ); 

list  =  list->next; 

) 

(  /'  print_list  '/ 


FILE:  usage/type/ 1 ibrary/1 ist .  c 


/* 

'  Copyright  1991 

'  Georgia  Institute  of  Technology 
'  Computer  Engineering  Research  Laboratory 
'  Author:  Stephen  R.  Wachtel 

*/ 


"UNDEFINED 
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extern  char  'parse (  ); 
extern  char  “merge (  ); 


char  “list(  input_list,  delimeter  ) 
register  char  *input_list; 
register  char  “delimeter; 
l 

register  char  *output_list; 

register  char  “list; 

register  char  “temporary; 

output_list  =  parse!  input_iist  ); 

list  =  parse!  input_list  ); 

while  (  list  !=  (char  *)0  ) 

temporary  =  merge!  "%s%s%s",  output_iist,  delimeter,  list  ); 

free!  output_list  ); 

free (  list  ) ; 

output_list  =  temporary; 

list  =  parse!  input_list  ); 

1 

return!  output_list  ); 
i  /*  list  »/ 


FILE:  usage/type/iit rary /main . c 


/* 

*  Copyright  1991 

’  Georgia  Institute  f  Technology 
'  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  <stdio.h> 
((include  <string.h> 


extern  FILE  “yyin; 
extern  FILE  “yyout; 
extern  char  *default_integer; 
extern  char  *de f aul t  1 ogical ; 


#define  PROGRAM  argument!  0  1 
#define  INPUT_FILE  argument!  1  ] 
((define  OUTPUT_FILE  argument!  2  1 


int  main!  number_argument ,  argument  ) 
int  numbe r_a rgument ; 
char  “argument!  ); 

( 

loop: 

if  (  strcmp!  argument!  number_argument  -  1  ],  "-size=2”  )  ==  0  ) 
( 

number_a rgument--; 
default_integer  =  "INTEGER*!"; 
default_l ogical  =  "L0GICAL*2"; 
goto  loop; 

) 

if  (  strcmp!  argument!  numl'er_argument  -11,  "-size=4"  )  ==  0  ) 

( 

number_a  rgument  —  ; 
default_integer  =  "INTEGER"!  ”  ; 
def ault_logical  =  "LOGICAL**!"; 
got  r*  1  o^ri ; 

) 

implinit_iiiitialize  (  ); 

if  (  number_a rgument  ==  1  ) 

( 
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yyin  =  stdin; 
yyout  =  stdout; 

yyparse (  ) ; 
exi  t  (  0  ) ; 

) 

if  (  number_argument  ==  3  ) 

{ 

if  (  (  yyin  »  fopent  INPUT_FILE,  "r“  )  )  ==  (FILE  - )  NULL  ) 

( 

fprintf  (  stderr,  "%s:  ERROR  -  unable  to  open  input,  file  '%s'\n",  PROGRAM, 
INPUT_FILE  )  ; 

exit (  -1  ) ; 

) 

if  (  <  yyout  =  fopen  (  3L-TPGT_F;LE,  "w“  )  )  --  (FILE  * )  NULL  ) 

f 

fprintf (  stderr,  "%s:  ERROR  -  unable  to  open  output  file  ' %s'\n“,  PROGRAM, 
o(JTPUT_FTLE  )  : 

exit (  -1  ) ; 

} 

yyparse (  ); 
exit (  0  ) ; 

} 

fprintf (  stderr,  "usage:  %s  <input  file>  <output  file>  [-size=2  or  4|\n",  PROGRAM  ) ; 
exit (  0  ); 

)  /*  main  */ 


FILE:  usage/type/ library /merge . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  <malloc.h> 


♦define  STRLEN!  s  )  (  strlen(  s  )  -  2  ) 


char  'merge!  string,  a,  b,  c,  d  ) 
register  char  'string; 
register  char  *a; 
register  cnar  *b; 
register  char  *c; 
register  char  *d; 

( 

register  char  'temporary  =  (char  *)NULL; 

switch  (  count (  string,  strlenf  string  ),  •%•  )  ) 

( 

case  0: 

if  (  (  temporary  =  (char  *)ma!loc(  strlenf  string  )+!))'=  (chat  ‘inuLL  ) 
sprintfl  temporary,  string  ); 

else 

fprintf!  stderr,  "ERROR:  merge!  %s  )\n",  string  ); 

break ; 

case  1: 

if  (  (  temporary  »  (char  *)malloc(  strlenl  string  )  +  STRLEN  (  a  )  +  1  )  )  '.= 

(char  * ) NULL  ) 

sprintfl  temporary,  string,  a  ); 

else 

fprintf (  stderr,  "ERROR:  merge!  %s,  %s  )\n",  string,  a  ) ; 

break; 

case  2: 

if  (  (  temporary  =  (char  '(mailed  strlen(  string  )  +  STRLEN (  a  )  *  STRLEN!  b 

)  +  1  )  )  !-  (char  *)NULL  ) 

sprintfl  temporary,  string,  a,  b  ) ; 
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else 

fprintf(  stderr,  "ERROR:  merge!  %s,  %s,  %s  )\.n",  string,  a,  b  ) 

break; 

case  3: 

if  (  (  temporary  =  (char  '[nailed  strlen  (  string  )  +  STSLEN  (  a  ) 

)  +  STRLEN (  c  )  +  1  )  )  ! =  (char  '[NULL  ) 

sprintfl  temporary,  string,  a,  b,  c  )  ; 

else 

fprintf(  stderr,  "ERROR:  merge (  %s,  %s,  %s,  %s  )\n",  string,  a, 
break; 

case  A: 

if  (  (  temporary  =  (char  '[mallocl  strienl  string  )  +  STRLEN (  a  ) 

)  +  STRLEN (  c  )  +  STRLEN (  d  )  +  1  )  )  !=  (char  '[NULL  ) 

sprintf(  temporary,  string,  a,  b,  c,  d  )  ; 

else 

fprintfl  stderr,  "ERROR:  merge!  %s,  %s,  %s,  %s,  %s  )\n",  strin.c 

)  ; 

break; 
default : 

fprintf(  stderr,  "ERROR:  merge (  %s  )\n”,  string  ); 
break; 

} 


return)  temporary  ); 
}  /*  merge  */ 


t ILE :  usage /type/ 1 ibr ary /non_bi an k . c 


/* 

'  Copyright  1991 

'  Georgia  Institute  of  Technology 
'  Computer  Engineering  Research  Laboratory 
*  Author:  Stephen  R.  Wachtel 

'/ 


♦include  <string.h> 


char  *non_blank(  string  ) 
register  char  'string; 

( 

register  int  offset; 
register  int  length; 


length  =  strlen!  string  ) 

-  1; 

while  (  (  string!  length 

string!  length--  ]  = 

1  ==  •  • 
•MV  ; 

)  && 

(  string!  length  ] 

!  =  ■  \0 

offset  =  0; 

while  (  (  string!  offset 
string!  offset++  ]  = 

strcpy(  string,  istring! 

1  —  *  ’ 

’  \  0 1  ; 

offset  i 

)  £4 

)  ; 

(  string[  offset  ] 

!-  ’\0 

if  (  strlen(  string  )  '.=  0  ) 

return  (  string  ) ; 

t  -  se 

return (  0  ) ; 

)  /'  non  blank  '/ 


FILE:  usage/type/ 1 ibrary /parse . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 
'  Author:  Stephen  R.  Wachtel 

'/ 


STRLEN!  b 


b,  c  )  ; 


STRLEN (  b 


,  a. 


♦include  <string.h> 
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extern  char  "duplicate!  ); 


char  *p„rse,'  list  l 
register  char  "list; 

( 

register  int  length  =  0; 

re^iscet  int  brace  =  0; 

register  char  "temporary  =  (char  ")0; 

for  ( ; ; ) 

( 

switch  (  list[  length  ]  ) 

( 

cast  '  (  '  " 

brace++; 

break; 

case  1 ) ' : 

brace — ; 
break; 

1 

if  (  brace  ==  0  ) 
break; 

length""; 

) 

if  (  length  0  ) 

( 

list[  length  1  1  \0'; 

temporary  =  duplicate!  list  +  1  ); 

strcpy!  list,  list  +  1  +  length  ); 

) 

else 

{ 

if  (  list[  length  j  !=  ' \ 0 '  ) 

{ 

temporary  =  duplicate!  list  ); 
list[  length  1  =  'NO'; 

1 

1 

return!  temporary  ); 

)  /*  parse  */ 


FILE:  usage/ type  / 1  ibr  ary /summary  .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


#include  <stdio.h> 
♦include  "list.h" 


extern  FILE  *yyin; 
extern  FILE  "yyout; 


void  summary!  ) 

( 

fprintf!  yyout,  "%d\n",  length_list(  _li st  )  ); 

print_list(  yyout,  _list_  ); 

)  /*  summary  */ 


FILE:  usage/type/ 1 ibrary /type . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 
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*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 

*/ 


((include  <string.h> 


extern  char  ’duplicate!  ); 
extern  char  ’merge!  ); 


char  *default_integer  =  "INTEGER’ A " ; 
char  ’default  logical  -  "LOGICAL’ 4 " ; 


char  ’type!  type_name,  type_length  ) 
register  char  *type_name; 
register  char  ’type_length; 


if 

(  type_length  !=  (char  *10  ) 
return!  merge!  "%s*%s",  type  name,  type_ 

length 

if 

(  stremp!  type  name,  "CHARACTER"  1  ==  0  1 
return!  duplicate!  "CHARACTER’!"  1  ); 

if 

(  stremp!  type  name,  "COMPLEX"  )  ==  0  1 
return!  duplicate!  "COMPLEX’8"  )  ); 

if 

(  stremp!  type  name,  "DOUBLE_PRECISICN" 
return!  duplicate!  "REAL*8"  )  1; 

*  ==  0 

if 

(  stremp!  type_name,  "INTEGER"  )  ==  0  1 
return!  duplicate!  def ault_integer  1  1; 

if 

(  stremp!  type_name,  "LOGICAL"  )  ==  0  ) 
return!  duplicate!  def ault_logical  )  ,; 

if 

(  stremp!  type_name,  "REAL"  )  ==  0  ) 
return!  duplicate!  "REAL* 4"  )  1; 

return!  duplicate!  type_name  )  ); 
/*  type  */ 


FILE:  usage /type /I ibrary /uppercase. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  technology 

’  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 

*/ 


char  ’uppercase!  string  ) 
register  char  ’string; 

{ 

register  int  index  =  0; 

while  (  string!  index  1  !=  '\0'  ) 

i 

string!  index  ]  =  toupper (  string!  index  ]  1; 

index”; 

1 

return (  string  )  ; 

}  /*  uppercase  */ 


FILE :  usage/ type/ 1 ibra ry /yyerror . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 

*/ 


482 


Annual  Report:  Digital  Emulaiion  Technology  Laboratory  Volume  1,  Pan  2 


iinclude  <stdio.h> 


extern  int  yylineno; 

void  yyerror!  string  ) 
register  char  ‘string; 
i 

fprintf!  stderr,  "line  %d,  %s\n",  yylineno,  string  ); 

exit (  -1  ) ; 

)  /*  yyerror  */ 

FILE :  usage/ type/ 1 ibrary /yygetc. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

•/ 


iinclude  <stdio.h> 
iinclude  <ctype.h> 


extern  int  yylineno; 


int  tab(  length  ) 
register  int  length; 

i 

wh»le  (  length--  !=  0  ) 
yyunput (  '  '  ) ; 

return (  '  '  )  ; 

)  /*  tab  */ 


int  yygetc!  file  ) 
register  FILE  ‘file; 

( 


int 

c; 

int 

column {  6 

1 ; 

if 

(  (  c=getc(  file)  ) 

-=  '\f 

! 

c  =  tab!  6 

)  ; 

if 

(  c  ! -  ■ \n ' 

) 

return (  c 

; 

if 

(  (  column! 

0  ]  =  getc ( 

file  ) 

)  !  - 

goto  abort 

_0; 

if 

(  (  column! 

~1  1  =  getc! 

file  ) 

)  !  = 

goto  abort 

_1; 

if 

1  (  column! 

2  ]  =  getc ( 

file  ) 

)  !  = 

goto  abort 

2; 

if 

(  (  column! 

3  J  =  getc! 

file  ) 

)  !  - 

goto  abort 

_3; 

if 

(  (  column! 

4  1  =  getc  ( 

file  ) 

)  !  = 

goto  abort 

J; 

i  f 

(  isspace! 

column!  5  ] 

=  getc! 

file 

goto  abort 

5; 

yy 1 i neno++ ; 
goto  loop; 

abort_5 : 

if  (  column!  5  J  ==  '\t'  ) 
tab (  1  ) ; 
else 
< 

yyunput!  column!  5  ]  ); 
if  (  column!  5  ]  ==  '\n'  ) 
yy ! i neno+  * ; 
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abort_4 : 

if  (  column!  A  ]  ==  '\t'  ) 
tab (  2  ) ; 

else 

f 

yyunput!  column!  A  ]  ); 

if  (  column!  4  )  ==  * \n'  ) 
yyl ineno+t ; 

) 

abort_3 : 

if  (  column!  3  )  ==  '\t'  ) 
cab (  3  ) ; 

else 

yyunput!  column!  J  ]  ); 
if  (  column!  3  )  ==  ' \n'  ) 
yy 1 ineno++ ; 

) 

abort_2 : 

if  (  column!  2  J  ==  '\t‘  ) 
tab (  4  )  ; 

else 

{ 

yyunput!  column!  21); 
if  (  column!  2  1  ==  '\n'  ) 
yylineno++; 

) 

abort_l : 

if  (  column!  1  ]  ==  • \t'  ) 
tab (  5  ) ; 

else 

i 

yyunput!  column!  1  ]  ) ; 
i f  (  column [  1  1  ==  ' \n 1  ) 
yylineno++; 

) 

abort_0 : 

if  (  column!  0  1  ==  '\t'  ) 

tab  v  £  it 

else 

{ 

yyunput!  column!  0  ]  ); 
if  (  column!  0  1  ««  '\n'  ) 
yy  lineno*  +  ; 

} 

return i  ^  ) ; 

)  /*  yygetc  */ 


FILE:  usage/type/library/yywrap.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


int  yywrap!  ) 

( 

return  (  1  ;  ; 
)  /*  yywrap  */ 


FILE:  usage/type/ scanner  .  1 


%( 

/* 

*  Copyright  1991 

*  Georgia  Institute  of  Techno! "gy 

*  Computer  Engineering  Research  Laboratory 


484  Annual  Report:  Digital  Emulation  Technology  Laboratory  Volume  1,  Part 


*  Author:  Stephen  a.  Wachtei 

*/ 

%) 


*a  10000 
»e  10000 
»k  10000 
%n  10000 
%  o  10000 

%p  10000 


a  [  aA : 
b  f  bB  i 
c  [cc; 
a  ;  do : 
e  [  eE : 
f  j  f  F  ! 
q  [qG; 
h  !  b.H  1 

1  [iI.! 
Z  [  jO  j 

k  [kK] 

1  [1L) 

m  [  mM ; 
n  [  nN  j 
o  £o0] 
p  [ppi 
q  [qQi 
r  [rR] 
s  [sS! 
t  itT] 
u  [uUl 
v  { vV  ] 
w  [wW] 
x  [  xX  i 
y  [yYl 
z  [ZZ] 


*1 

♦include  "gramma r . h” 
extern  char  *yy 1 va  l ; 


♦  unde  f  YYLMAX 
♦define  YYLMAX  (256*20) 


extern  char 
extern  char 
extern  char 
extern  char 

*1 


•duplicate!  ) 
•hollerithf  ) 
*non_biank(  ) 
•uppercase  (  ) 


'[\*cC] . * (\nl  ' 

'  !  \  ’  (  \  n )  ( 

♦  i  f  de ..  DEBUG 

ECHO; 

♦  endi  f 

yylval  =  duplicate!  yytext  ); 
return!  COMMENT  ); 

i 


[\  1  ( 

♦  i f de  f  DEBUG 
ECHO; 

♦endi f 

/*  return  (  1 ’  )  * / ; 

) 


r  \  & }  j 

♦ifdef  DEBUG 
ECHO; 
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tend!  f 

return  I  1 \& '  ) ; 


[  \  i ;  { 

1 1 fdef  DEBUG 
ECHO; 
tend i f 

return  !  ' \  (  •  )  ; 


:  \  )  1  i 

tifdef  DEBUG 
ECHO; 

*  end  i  f 

return  (  ’  '  )  '  ); 


i  \  w  :  t 

#i fdef  DEBUG 
ECHO; 
tend  i  f 

return  (  ' \ * •  ) ; 


; \*l  [\*  ]  ; 

tifdef  DEdUu 
ECHO; 
i end;  f 

return!  EXPONENTIATE  ); 

! 


\  *  ;  ( 

tifdef  DEBUG 
ECHO; 
tend! f 

return  (  '  \+  •  )  ; 

l 


;  \ ,  ;  ( 

t  i  fdef  DEBUG 
ECHO; 
tend: f 

return!  ' \ , '  ) ; 


tifdef  DEBUG 
ECHO; 
tend, t 

return  I  '  \-  '  )  ; 

l 


:  V  .  :  i 

tifdef  DEBUG 
ECHO; 
tend i  f 

ret  urn  (  '  '  )  ; 

i 


;\/i  ! 

t i fde  f  DEBUG 
ECHO; 
tend i  f 

return (  • \ / •  ) ; 

1 


t i fdef  DEBUG 
ECHO; 
tend  i  f 
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return  { 


)  ; 


;  \  =  :  { 

#ifdef  DEBUG 
ECHO; 
lend 1 1 

return (  ' \ = '  » ; 


*itdef  DEBUG 
ECHO; 

#en.d  i  f 

/" '  return  (  '\n'  )  */; 


DEBUG 


/  *  return!  1 \ t  *  )  *  ' ; 


#  i  f  de  _ 
ECH 

*endi f 


'  \  .  ’  {  a  M  n }  {  d }  [  \  .  I  { 

# i fdef  DEBUG 
ECHO; 
ter.di  £ 

return!  RW_AND  ); 

} 


;  \  .  ;  {  e  \  ( q }  [  \  .  ;  ! 

* i fdef  DEBUG 
ECHO; 
f  enai  f 

return!  RW_EQ  ); 
f 


i  {eMqKvj  (\.  |  { 

#i fdef  DEBUG 
ECHO; 

*endi  f 

return (  RW  EQV  ) ; 


[  \  .  !  »  f  M  a )  { 1  >  {  s }  { e  >  [  \  .  ; 
#ifdef  DEBUG 
ECHO; 

#endi  f 

return (  RW  FALSE  ) ; 


[  \  .  ]  (  q  )  [  e }  (  \  .  ]  ( 

# i f de  f  DEBUG 
ECHO; 

#en.di  f 

return!  RW  GE  ); 


f  \  .  M  g )  { t }  [  \  .  1  { 

* i £ de f  DEBUG 
ECHO; 

♦  end  i  f 

return!  RW  GT  ) ; 


> \ . 1 flifei [ \ ■  • 

*  i  fdef  DEBUG 

ECHO; 

*  e  r.  d  i  f 

return  (  RW  LF  ) ; 
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[\.] {1} { t }  [\.  ]  ( 

#ifdef  DEBUG 
ECHO; 

#endi f 

return  1  RW_LT  ) ; 

) 


[\-](n)(e>[\-l  ( 

Ififdef  DEBUG 
ECHO; 

Kendi f 

return)  RW_NE  ); 

I 


[\. ]  (n) (e) (q) (v)  [\.  ]  ( 

#i fdef  DEBUG 
ECHO; 

#endi  f 

return (  RW_NEQV  ) ; 

I 


1 (n) (O! (t) [\.l  ( 

#ifdef  DEBUG 
ECHO; 

#endi  f 

return)  RW^NOT  ); 

) 


[\.]{o)ir)[\-]  ( 

#i fdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_OR  I ; 

) 


(\-l{t}(r)(u)(e)t\.l  ( 

#ifdef  DEBUG 
ECHO; 

#er.di  f 

return)  RW_FRUE  ); 

) 


lallsllsliillglinl  f 
# i f def  DEBUG 
ECHO; 

#endif 

return)  RW_ASSIGN  ); 

) 


(b> (a) (c) (k) (s! (pi (al)c' (el  1 
ilfdef  DEBUG 
ECHO; 

#endi  f 

return (  RW_BACKSPACE  ); 

) 


(b)(llioKc|(k)(\  ]  *(d)  (a)  (t)  (ai  ( 
Kifdef  DEBUG 
ECHO; 
lendi f 

return)  RW_BLOCK_DATA  ); 

) 


IcHaMlill)  ( 

Kifdef  DEBUG 
ECHO; 

Kendi f 

return  (  RW  .’ALL  )  ; 

) 
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!cHh)laHrHai(cHtl(e){r|  1 
♦  ifdef  DEBUG 
ECHO; 

#endi f 

return (  RW_CHARACTER  ); 

1 


(cHlHo)UHe)  { 
lifdef  DEBUG 
ECHO; 

#endi f 

return!  RW_CLOSE  ); 

} 


(c) (ol (m) (ml (o) (n(  { 
tifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_COMMON  ) ; 

) 


(c) (o) (ml (p) (11(e) (x)  ( 

#i fdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_CCMPLEX  ) ; 

1 


( c) ( o) (n) { t } (i ) { n J  |u)  I e }  ( 

# i fdef  DEBUG 
ECHO; 

#endi  ' 

return!  RW_CONTINUE  1; 

) 


!d)(a)(t)(a)  ( 

lifdef  CEBUG 
ECHO; 

#endi f 

return (  RW_DATA  ) ; 

1 


( d )  (  i  (  ( n  1  ( e  )  ( n  1  (  s  ;•  {  i  )( o  J  (  n )  ( 

# i fdef  DEBUG 
echo; 

#enai f 

return!  RW_DIKENSICN  ); 

) 


( d )  (  o )  { 

♦i fdef  DEBUG 
ECHO; 
lendi f 

return!  RW_DO  ); 

1 


(d)  ( o  1  (uHbl!  1 1(e)  [\  1  *  ( pl(  r )( e )(  all  i  )  (  s ) !  l )!  o '  i  n)  ( 
# i fde  f  DEBUG 
ECHC; 
t‘-»ndi  f 

return!  RW_DOUBLE_PRECISION  ); 

1 


(e|(l)(s|(6|  { 

#ifdef  DEBUG 
ECHO; 
itendi  f 

return!  RW_EL3E  i; 

} 


18.  Appendix  M:  usage  program  source 


489 


(e)(l}(s)(e}[\  1 *{i j { f }  f 
#i fdef  DEBUG 
ECHO; 

#endi f 

return!  RW_ELSE_IF  ); 

) 


(e) {ni (d)  ( 

#ifdef  DEBUG 
ECHO; 

#endi  f 

return!  RW_END  ); 

) 


!e|(n)(d)[\  ! * (i K  f 1  { 

#ifdef  DEBUG 
ECHO; 

#endi f 

return!  RW_END__IF  ); 

1 


!e)  |nHd|(£)!iiUMei  ( 

# i fdef  DEBUG 
ECHO; 

#endif 

return!  RW_ENDFILE  ); 

1 


(eHn)ttHr)  (y(  ( 

#i fdef  DEBUG 
ECHO; 

#endi  f 

return!  RW_ENTRY  ); 

1 


(eMqHuHiHvHaHl)  (eHnHcHe)  l 
#ifdef  DEBUG 
ECHO; 

Kendi f 

return!  RW_EQU I VALENCE  ); 

) 


(el(xl(tHel|rl|n||a||ll  ! 

# i f de  f  DEBUG 
ECHO; 

*endi  £ 

return!  RW_EXTERNAL  ); 

1 


(£lIol!r||nlla)(tl.*  ( 

♦i fdef  DEBUG 
ECHO; 
lendi f 

yylval  =  duplicate!  yytext  ): 
return!  RW  FORMAT  ); 

) 


(fllul|nHcHtHi|(o)|n|  ! 

#i fdef  DEBUG 
ECHO; 

Kendi f 

return!  RW_FUNCTION  ); 

) 


(qlfoHN  i  -ft}  (  o  1  ( 

Kifdef  DEBUG 
ECHO; 

#endi  f 

return!  RW_GO_TO  ); 

} 
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fiHfl  f 
tifdef  DEBUG 
ECHO; 
tendi f 

return!  RW_IF  ); 

1 


(iHmHp)  (1)  UHcHiltt)  t 
tifdef  DEBUG 
ECHO; 
tendi f 

return  (  RW_IMPLICIT  ); 

1 


(iHnHcHlHuHdHel  { 
tifdef  DEBUG 
ECHO; 
tendi  f 

return (  RW_INCLUDE  ); 

1 


|i|(nHq)(u)(iHrHe|  { 
tifdef  DEBUG 
ECHO; 
tendi  f 

return (  RW_INQUIRE  ); 

1 


lillnKtHeHgliellr!  ( 
tifdef  DEBUG 
ECHO; 
tendi f 

return  (  RW_INTEGER  ) ; 

1 


li}(n)(t)(rlfi)|n)|3)(i)|c)  ( 

tifdef  DEBUG 
ECHO; 
tendi f 

return  (  RW_INTRINSIC  ); 

1 


(lHoMglfiHc)UHl)  ( 

tifdef  DEBUG 
ECHO; 
tendi  f 

return)  RW_LOGICAL  ); 

1 


1 n )( a ) (m) (e I { 1 H i )( s)( t 1  ( 

tifdef  DEBUG 
ECHO; 
tendi f 

return)  RW_NAMELIST  ); 

} 


(oHpMeMn)  ( 
tifdef  DEBUG 
ECHO; 
tendi  f 

return  (  RW_OPEN  ) ; 

} 


|p)la||rHaHml|eHtHe|(r|  ( 
tifdef  DEBUG 
ECHO; 
tendi  f 

return)  RW_PARAMETER  ); 

) 
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( pi {a} (u) {s) {el  ( 

Hi fdef  DEBUG 
ECHO; 
iendi f 

return (  RW_PAUSE  ); 

} 


(Pi ( r ) f i ) ( n> { t )  { 

# i fdef  DEBUG 
ECHO; 
ftendi  f 

return!  RW_PRINT  ); 

1 


( p )  (  r }  { o )  ( g  1  (  r )  ( a }  ( m )  { 

# i fdef  DEBUG 
ECHO; 

#endi f 

return!  RW_PROGRAM  ); 

) 


IrHelUHd)  { 

# i f de  f  DEBUG 
ECHO; 

(fendi.  f 

return (  RW_READ  ) ; 

) 


(rl(e)(a|(l)  ( 

# i fdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_REAL  ) ; 

1 


(r) (e) ( t ) (u) ( r) { n >  ( 

#i fdef  DEBUG 
ECHO; 

#endi  f 

return (  RW_RETURN  ) ; 

1 


IrHellwMiHnHd)  { 

# i fdef  DEBUG 
ECHO; 

#endi f 

return!  RW_REWIND  ); 

1 


( s 1 (a) (v) (e)  { 

# i f de  E  DEBUG 
ECHO; 

#endi f 

return  (  RW_SAVE  ) ; 

1 


f  3)  (t)  (O)  (p)  ( 

It  1  fdef  DEBUG 
ECHO; 

Kendi f 

return!  RW_STOP  ); 

1 


(sl{u|(bHr)(o)(u)(tHi)(n){e|  ( 

Hi fdef  DEBUG 
ECHO; 

Itendi  f 

return!  RW_SUBROUTINE  ); 

1 


Itl lh||e| |n| 


I 
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If  i  fdef  DEBUG 
ECHO; 

#endi f 

return (  RW_THEN  ); 

) 


{t)<o)  { 

Hifdef  DEBUG 
ECHO; 

#endi  f 

return (  RW_TO  ); 

1 


iwKrlliHtHe)  { 

If i fdef  DEBUG 
ECHO; 

Ifendif 

return  (  RW_WRITE  ); 

1 


(uHn)|dl(eH£}(i)(n)(e)|d)  { 

#i fdef  DEBUG 
ECHO; 

Ifendif 

return (  RW_UNDEFINED  ); 

1 


[%a-zA-Z] [_a-zA-Z0-9] *  ( 

If  i  fdef  DEBUG 
ECHO; 

Ifendi  f 

yylval  =  duplicate (  uppercase!  yytext  )  ); 
return (  IDENTIFIER  ); 

1 


'[0-9  ]  [0-9  1  [0-9  ]  [0-9  ]  [0-9  1  [\  1  ( 

If  i  fdef  DEBUG 
ECHO; 

Ifendi  f 

yylval  =  duplicate (  non_blank(  yytext  )  ); 
return (  LABEL  ) ; 

) 


[0-9] +  I 

(0-9]+/\. [a-zA-Z]+\.  ( 

#ifdef  DEBUG 
ECHO; 

#endi f 

yylval  =  duplicate!  yytext  ); 
return!  INTEGER  ); 

) 


[0-91 +\. t 0-9)* ( [eE] [\+\-] ? [0-91+) ?  I 
[0-91 *\. [0-9] + ( [eE] [\+\-l ? [0-9] +) ?  t 
[0-9]  +  ( [eE]  [\  +  \-]?[0-9]+)?( 

# 1 fdef  DEBUG 
ECHO; 

Ifendi  f 

yylval  =  duplicate!  yytext  ); 
return!  REAL  ); 

) 


[0-9] +  \.  [0-9]*((dD]  [\  +  \-]  ?  [0-9j  +  )  ? 
[0-9]  *  \  .  [0-9]  +  (  [dD]  [\  +  \-]  ?  [0-9]  +  )  ? 
[0-9)  +  ( [dD]  [\  +  \-J  ?[0-9J  +)  ?  ( 

II 1  fdef  DEBUG 
ECHO; 
ifendi  f 

yylval  =  duplicate!  yytext  ); 
return!  DOUBLE  PRECISION  ); 
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vrv]*v  l 

\”r\")*\“  , 

#i fdef  DEBUG 
ECHO; 

#endi f 

yytext [  0  1  =  ' ; 
yytext  [  strlen(  yytext  )  -  1  1 
yylval  =  duplicate!  yytext  ); 
return!  STRING  ); 

} 


' \“  ‘ 


[0-9]  +  [hH]  ( 

# i fdef  DEBUG 
ECHO; 

#endi f 

yylval  =  duplicate!  holierith!  yytext,  ' )  ); 

return!  HOLLERITH  ); 

> 


FILE :  usage/ type /statement /Makefile 


* 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

K  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 


CC  =  cc  -g 
INCLUDE  =  ../include 
CFLAGS  =  -1$ (INCLUDE) 
LIBRARY  =  statement. a 


OBJECTS  =  \ 

common_3tatement . o  \ 
declaration_statement . o  \ 
dimension_statement . o  \ 
do_statement . o  \ 
end_statement . o  \ 
function_statement . o  \ 
impl icit_statement . o  \ 
parameter_statement . o 


S (LIBRARY) : S (OBJECTS) 
rm  -f  S( LIBRARY) 
ar  crv  S (LIBRARY)  S (OBJECTS) 
ranlib  $ (LIBRARY) 


■SUFFIXES:  .c  .o 
.  c.  o: 

$ (CC)  -c  S (CFLAGS)  S< 

clean: 


rm  -f  S (LIBRARY)  S (OBJECTS) 


FILE:  usage/ type/ statement /common_statement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


((include  "list.h" 

I include  “class. h" 


extern  char  ‘duplicate!  ); 
extern  char  ‘parse  (  ); 
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void  common_statement  (  common_name,  common_Iist  ) 
register  char  *common_name; 
register  char  *common_list; 

{ 

register  char  *comm',n; 
register  char  ‘identifier; 
register  char  *subscript_list; 

if  (  common_name  *=  (char  *)0  ) 

common  -  duplicate  (  "_CGMMCR_”  ); 

add_list(  0,  common_name,  0,  0,  IMPLICIT  I  GLOBAL  I  VARIABLE  ); 

while  (  common  =  oarse (  common_list  )  ) 

( 

identifier  =  parse (  common  ); 
subscript_list  =  parse (  common  ); 

if  (  subscript_list  •>»  (char  *)0  ) 

add  list(  common_name,  identifier,  0,  suDscript_list,  IMPLICIT  i 

VARIABLE  ) ; 

else 

add_list (  common_name,  identifier,  0,  subscr i pt_list ,  IMPLICIT  ( 
VARIABLE  i  ARRAY  ) ; 

) 

)  /*  common_statement  */ 


FILE :  usage/ type /statement /decl a rat ion_st a tement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  P.  Wachtel 

*/ 


♦include  “list.h" 
♦include  "class. h" 


extern  char  ‘parse (  ) ; 


void  declaration_statement (  type,  declarat ion_l ist  ) 

register  char  ‘type; 

register  char  ‘declaration  list; 

( 

register  char  ‘declaration; 
register  char  ‘identifier; 
register  char  *subscript_list; 

while  (  declaration  =  parse (  declaration_list  )  ) 

identifier  =  parse (  declaration  ); 
subscript_l i st  =  parse!  declaration  ); 

if  (  subscript_l i st  ==  (char  *)0  ! 

add_list (  0,  identifier,  type,  subscript_list,  EXPLICIT  \  LOCAL 

else 

add  list(  0,  identifier,  type,  subscr ipt_i ist ,  EXPLICIT  1  LOCAL 

ARRAY  ) ; 

f 

)  /*  dec!aration_statement  */ 


FILE:  usage/type/statement/dimension_statement .  c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


LOCAL  | 

LOCAL  [ 


I  VARIABLE  ) 
|  VARIABLE  I 
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((include  "list.h" 
♦include  "clasc.h" 


extern  char  ‘parse  (  ); 


void  dimension_statement  (  dimensior._Iist  ) 
register  char  *dimension_list; 

( 

register  char  ‘dimension; 
register  char  'identifier; 
register  char  ‘subscript_l i st ; 

while  (  dimension  =  parse (  dimension_iist  )  ) 

( 

identifier  =  parse (  dimension  ); 
subscript  list  =  parse (  dimension  !; 

add_list<  0,  identifier,  0,  subscript_list,  IMPLICIT  I  LOCAL  I  VARIABLE 

1 

}  /*  dimension  statement  */ 


FILE;  usage/ type / st atement /do_s tat em.ent .  c 


/* 

*  Copyright  1991 

*  3  Trn‘itute  cf  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  "list.h" 
♦include  "class. h" 


void  do_statement (  label,  identifier,  expression_list  ) 
register  char  ‘label; 
register  char  ‘identifier; 
register  char  *expression_list; 

{ 

add_list (  0,  identifier,  0,  0,  IMPLICIT  I  LOCAL  I  VARIABLE  ); 
}  /*  do  statement  '/ 


FILE:  usage/ type/st atement /end_st atement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

’  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


void  end_statement  (  ) 

( 

implicit_initialize (  ); 
)  /*  end_statement  */ 


FILE :  u sage/type /s tat ement / f unct ion_st atement . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  "list.h” 
♦include  "class. h" 


void  function_statement (  type,  identifier,  formal_argument_list  ) 


ARRAY  ) ; 
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register  char  'type; 
register  char  'identifier; 
register  char  ' f ormal_argument_list ; 
i 

if  (  type  ==  (char  ')0  ) 

add_list (  0,  identifier,  type,  0,  IMPLICIT  |  GLOBAL  I  VARIABLE 

else 

add_list (  0,  identifier,  type,  0,  EXPLICIT  I  GLOBAL  I  VARIABLE 
)  /*  function_statement  '/ 


FILE :  usage/ type/ statement /implicit_statement . c 


/' 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

'  Computer  Engineering  Research  Laboratory 
'  Author:  Stephen  R.  Wachtei 

'/ 


extern  char  'parse  (  ); 


void  implicit_statement (  type,  impl ici t_i i st  ) 
register  char  'type; 
register  char  *implicit_list; 

( 

register  char  'implicit; 
register  char  ' lower_bound; 
register  char  *upper_bound; 

while  (  implicit  =  parse (  implicit_l ist  )  ) 

< 

lower_bound  =  parse)  implicit  ); 
upper_bound  =  parse (  implicit  ); 

type_impl icit (  type,  lower_bound,  upper_bound  ); 

} 

)  /*  implicit_statement  '/ 


FILE:  usage/ type /statement /parameter_statement . c 


/' 

*  Copyright  1991 

'  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtei 
*/ 


((include  "list.h" 
((include  "class. h" 


extern  char  'parse  (  ); 


void  parameter_statement (  parameter_iist  ) 
register  char  *parameter_iist; 

( 

register  char  'parameter; 
register  char  'identifier; 
register  char  'expression; 

while  (  parameter  =  parse (  parameter_list  )  ) 

( 

irfonti  f ier  =  parse!  parameter  ); 
expression  =  parse t  parameter  ); 

add_list (  0,  identifier,  0,  0,  IMPLICIT  I  LOCAL  I  CONSTANT  ) ; 

} 

(  /'  parameter_statement  */ 


FUNCTION  ) 
FUNCTION  ! 


FILE:  usage/usage/Make f i le 
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* 

#  Copyright  1991 

#  Georgia  Institute  of  Technology 

#  Computer  Engineering  Research  Laboratory 

#  Author:  Stephen  R.  Wachtel 

# 


default:  usage 


CC  =  cc  -g 
INCLUDE  =  include 
CFLAGS  =  -1$ (INCLUDE) 
LIBRARY  =  1 ibrary/library . a 


OBJECTS  =  \ 

$ (INCLUDE) /grammar. h  \ 
•grammar. [col  \ 
•scanner. [col  \ 
yytrace. [coj  \ 
y . output 


PROGRAMS  -  \ 

•usage 


grammar. c:  grammar. y 
yacc  -dv  grammar. y 
mv  y.tab.h  S  (INCLUDE) /grammar . h 
mv  y.tab.c  grammar. c 


scanner. c:  scanner.! 

lex  -vt  scanner. 1  I  sed  ' s/getc/yygetc/ '  >scanner.c 


scanner. o:  scanner. c  S (INCLUDE) /grammar. h 
$ (CC)  S (CFLAGS)  -c  scanner. c 

grammar. o:  grammar. c 

S (CC)  $ (CFLAGS)  -c  grammar. c 

usage:  grammar. o  scanner. o  $ (LIBRARY) 

S (CC)  -o  usage  grammar. o  scanner. o  S (LIBRARY) 


sgrammar . c:  grammar . c  yytoken.awk 

awk  -f  yytoken.awk  kgrammar.c  >sgrammar.c 

sgrammar.o: sgrammar. c 

S  (CC)  $ (CFLAGS)  -c  sgrammar. c 

susage:  sgrammar.o  scanner. o  S (LIBRARY) 

$(CC)  -o  susage  sgrammar.o  scanner. o  S(LIBRARY) 


dscanner.c:  scanner. c 

cp  scanner. c  dscanner.c 

dscanner.o: dscanner.c  S  (INCLUDE) /gramma r . h 
S(CC)  S (CFLAGS)  -DDEBUG  -c  dscanner.c 

dusage :  grammar. o  dscanner.o  $(LIBRASY) 

S(CC)  -o  dusage  grammar. o  dscanner.o  $ (LIBRARY) 


tgrammar.c: grammar. c 

sed  ' s/yystack: /£  yyt race (yy stat e) ; / '  <grammar.c  >tgrammar.c 


tgrammar.o: tgrammar.c 

$(CC)  S (CFLAGS)  -c  tgrammar.c 

’■usage:  tgrammar.o  scanner. o  yytrace. o  S  (LIBRARY) 

S (CC)  -o  tusage  tgrammar.o  scanner. o  yytrace.o  S (LIBRARY) 


yytrace. c:  grammar.c  yytrace. awk 

awk  -f  yytrace. awk  <y. output  >yytrace.c 
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yytrace.o:  yytrace.c 

$(CC)  $ (CFLAGS)  -c  yytrace.c 


clean : 

cd  library;  make  clean 
rm  -f  S (PROGRAMS)  S (OBJECTS) 


FILE:  usage/usage/grammar. y 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


/* 

*  FORTRAN  11 

*/ 


%token  RW_AND 

ttoken  RW_ASSIGN 

»token  RW_BACK SPACE 

%token  RW_BLOCK_OATA 

%token  RW_CALL 

%token  RW_CHARACTER 

*t oken  RW_CLOSE 

ttoken  RW_COMMON 

%token  RW_COMPLEX 

ttoken  RW_CONTINUE 

ttoken  RW_DATA 

%token  RW_DIMENSION 

ttoken  RW_DO 

%token  RW_DO_WHILE 

ttoken  RW_DOUBLE_PRECI SION 

ttoken  RW_ELSE 

ttoken  RW_ELSE_IF 

ttoken  RW  END 

ttoken  RW~END_DO 

ttoken  RW_END_IE 

ttoken  RW_ENDEILE 

ttoken  RW_ENTRY 

ttoken  RW_EQ 

ttoken  RW_EQU I VALENCE 

ttoken  RW_EQV 

ttoken  RW_EXTERNAL 

ttoken  RW_FALSE 

ttoken  RW_FORMAT 

ttoken  RW_FUNCTION 

ttoken  RW_GE 

ttoken  RW_GO_TO 

ttoken  RW_GT 

ttoken  RW_IF 

ttoken  RW_IMPLICIT 

ttoken  PW_INCLUDE 

ttoken  RW_INQUiRE 

ttoken  RW_INTEGER 

ttoken  RW_INTRINSIC 

ttoken  RW_LE 

ttoken  RW_LOGICAL 

ttoken  RW_LT 

ttoken  RW_NAMELIST 

ttoken  RW_NE 

ttoken  RW_NEQV 

ttoken  RW_NOT 

ttoken  RW_OPEN 

ttoken  RW_OR 

ttoken  RW_PARAMETER 

ttoken  RW_PAUSE 

ttoken  RW_PRINT 

ttoken  RW_PROGRAM 

ttoken  RW_READ 

ttoken  RW_REAL 

ttoken  RW_RETURN 

ttoken  RM_REWIND 

ttoken  RW  SAVE 
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%token 

RW  STOP 

%token 

RW  SUBROUTINE 

%token 

RW  THEN 

%t oken 

RW  TO 

% token 

RW  TRUE 

%t oken 

RW  WRITE 

%t oken 

RW_UNDEFINED 

%t oken 

CONCATENATE 

%t  oicen 

COMMENT 

%token 

DOUBLE  PRECIS 

%token 

EXPONENTIATE 

% token 

HOLLERITH 

%token 

IDENTIFIER 

%token 

INTEGER 

% token 

LABEL 

% token 

REAL 

%to<en 

STRING 

%ieft  • ,  1 
%nonassoc  '  :  ' 

%  right  '  =  ' 

♦  left  RW_ECV  RW_NEQV 
tie  ft  RW_CR 
tieft  RW_AND 
tieft  RW_NOT 

♦nonassoc  RW_EQ  RW_NE  KW_LT  RW_LE  RW_GT  RW_GE 

tieft  CONCATENATE 

tieft  ■+• 

tieft  ’**  ■/• 

tright  EXPONENTIATE 

tieft  SIGN 


%( 

typedef  char  "POINTER; 
♦define  YYSTYPE  POINTER 

♦include  "usage.h" 
static  int  usage  «  REF; 
static  int  enable  -  0; 

ft 


tt 


program : 

opt ional  staterent  1  i  st 


SuTinaryl  i; 
I 


optional  statement  list: 
/*  NULL  */'  * 


st  a  ten^ent  list 


statement _i i st : 

statement 


s  t  a  t  erne  n t  list  statement 


st  a 


nt : 

corment  _state  merit 

label  ur la Deled  statement 


Conner t _st a t emen t : 
"COMMENT 
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if  (  st.  rcmpt  $1, 
enable  =  1; 
if  (  strcmpt  $1, 
enable  «  0; 


label  : 

LABEL 


un label ed_st atement : 

include_st atement 

program  statement 

biock_dat  a_statemer. 

function_s*  atement 

subrout ine  statemen 

er.t  ry_st atement 

end_st atement 

i 

specificati on_st atement 
executabiest atement 
format  statement 


inciude_st atement : 

RW  INCLUDE  character  constant 


program_statement : 

RW_PROGRAM  program_ident i t ier 


program_ident i f i er : 

IDENTIFIER 

{ 

begin_block (  $1  )  ; 
enable  =  0; 


bloc)c_data_statement : 

RW  BLOCK  DATA  block;  data  identifier 


block _data_identi fier: 
IDENTIFIER 

beg;  n  _bl  ode  (  SI  ); 
enable  =  1 ; 


ct i on_ statement : 

RW_FUNC?ION  f  unct  l  on_  ider.t  i  f  ie  r  opt  lor.a  i_*orma  i_a  rgument  list 
type  RW_FUNCTION  fur.ct  ior._  ident  i  f  ier  opt  ;onal  _f  ormal  argument 


IDENTIFIER 

i 

beq i n  b 1 ock (  31  )  ; 

enable  -  1  ; 


list 
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1 


subrout i ne_st atement : 

RW_SUBROUTINE  sub  rout  ine_ider.ti  tier 
I 

RW_SUBROUTINE  subrcutine_ident i f ier  opt iona l_f ormal_argument_l 1st 


sub r ou t ine_i dent i t ie  r : 
IDENTIFIER 
{ 

begin_bloc!c  (  SI  >; 
enable  =  1; 

1 


ent  ry_st atement : 

RW_£NTRY  entry_identifier 
I 

RW_ENTRY  entry_identifier  opt ional_formal_argument_l i st 


ent ry_i dent i f ier : 

IDENTIFIER 


opt ional_f ormal_argument_I ist : 

'  ( '  '  )  ' 

'('  formal_argument_list  ')' 

formal_argument_li st : 

forma  l__a  rgument 
I 

formal__argument_l  ist  formal_argument 


formal_argument : 

IDENTIFIER 

( 

if  (  enable  ) 

add_formal_argument_list (  $1  ); 

) 

I 

f ormal_argument_alternate_return 
( 

if  (  enable  ) 

add_formal_argument_list (  SI  ); 

1 


formal_argument_alternate_return : 

«  *  » 

f 

SS  *  " " ; 

) 


end_statement : 

RW_END 

( 

end_bloclc(  ); 
enable  =  0; 

1 


speci float ion_statement : 

externa l_statement 
I 
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intrinsic  statement 

parameter_statement 

dimensi on_statement 

declaration_statement 

save_statement 

commcn_statement 

equivalence_statement 

implicit_statement 

data_stateir.ent 

namelist  statement 


external_statement : 

RW  EXTERNAL  external  list 


external_li st : 

external 

I 

external  list  external 


external : 

IDENTIFIER 


intrinsic_statement : 

RW  INTRINSIC  intrinsic  list 


intrinsic_list : 

intrinsic 

I 

intrinsic  list  intrinsic 


intrinsic: 

IDENTIFIER 


parameter_statement : 

RW_PARAMETER  '('  parameter_list  ')' 


parameter_list: 

parameter 

I 

parameter_list  parameter 


pa  rameter : 

parameter_identi tier  '='  expression 


parameter_ident i f ier : 

IDENTIFIER 

1 

if  (  enable  ) 

usaqe_ident i f ier (  SI,  SET  >; 

1 
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dime ns ion_statement : 

RW  DIMENSION  dimension  list 


dimension_llst : 

dimension 

I 

dimension_list  1 , '  dimension 


dimension: 

IDENTIFIER  '  ( ' subscript_list  ')' 


subscr ipt_l ist : 

subscript 

I 

subscript_list  subscript 


bound 

bound  ' : 1  upper_bound 


lower_bound: 

INTEGER 

I 

INTEGER  IDENTIFIER 

I 

'+*  INTEGER 
I 

INTEGER 

I 

IDENTIFIER 

I 

IDENTIFIER  • INTEGER 
I 

'+’  IDENTIFIER 

I 

IDENTIFIER 


subscript : 

upper 

I 

lower 


upper_bound: 

lower_bound 

I 

upper_bound_ad just able 


upper_bound_ad just able : 


declaration_statement : 

type  declaration_list 


declaration  list: 

declaration 

I 

declaration_list  declaration 


declaration: 

IDENTIFIER 

I 

IDENTIFIER 


opt iona l_type_ length 
’('  subscript_l i st  ')' 


optional_type_length 
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type: 

type_name  optional_type_length 


type_name: 

RW_CHARACTER 

i 

RW_COMPLEX 

I 

RW_DOUBLE_PRECISION 

I 

RW_INTEGER 

I 

RW_L0GICAL 

I 

RW_REAL 

1 

RW  UNDEFINED 


optional  type_length: 
r*  NULL  */ 

I 

type_length 


type_length: 

1  *  1  INTEGER 
I 

type_length_ad justable 


type_length_ad justable : 

i(i  i  »  •  •  )  « 


save_statement : 

RW_SAVE  optional_save_list 


optional  save_list: 
/*  NULL  */ 

I 

save  list 


save 


list: 

save 

save 


list 


save 


save : 
I 


IDENTIFIER 
common  name 


common_statement : 

RW_C0MM0N  opt ional_common_name  common_var i abie_i ist 


optional  common_name: 
r*  NULL  */ 

I 

common  name 


common  name: 
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’/'  opt ional_identi tier  '/■ 


optional  identifier: 
/*  NULL  */ 

I 

IDENTIFIER 


common_variable_list : 

common_variable 

I 

common  variable  list  common_variable 


common_variable : 

IDENTIFIER 

I 

IDENTIFIER  '('  subscript_list  ')' 


equi valence_statement : 

RW_EQU I VALENCE  equi valence_l i st 


equivalence_list : 

equivalence 


equivalence_list 


equivalence 


equivalence: 

'('  equivalence_variable_list  ')' 


equivalence_variable_list : 

equivalence_variable 

I 

equivalence_variable_list  ' , '  equivalence_variable 


equivalence_variable : 

IDENTIFIER 

I 

IDENTIFIER  '('  subscript_list  •)' 


implicit_statement : 

RW_IMPLICIT  type  implicit_list  ')' 


implicit_list : 

implicit 

implicit_list  implicit 


implicit : 

IDENTIFIER 


IDENTIFIER  •-*  IDENTIFIER 


namel i st_statement : 

RW  NAMELIST  namelist  name  namelist  list 


namelist  name: 
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•/'  IDENTIFIER 


namelist_list : 

namelist 

I 

namelist_list  namelist 


namel 1 st : 

IDENTIFIER 


data_statement : 

RW  DATA  data  list 


data_list: 

data 


oata: 


data_li st  optional_comma  data 


data  variable  list  ■/'  data  constant  list  '/* 


data_variable_list : 

datavariable 

I 

data_variable_list  data_variable 


data_variable: 

variable 

( 

if  (  enable  ) 

usage_identi f ier (  $1,  SET  ); 

1 


data_implied_do_list 


data_implied_do_list : 

'('  data_variable_list  IDENTIFIER  •='  expression_list  ') 


data_constant_l i st : 

data_constant 

I 

data  constant  list 


data  constant 


data_constant : 

data_value 

I 

IDENTIFIER  '*'  data_value 

l 

INTEGER  ' *  1  data  value 


data_value: 

IDENTIFIER 

I 

cha  racter_constant 

I 

logical_constant 

I 


numerical  constant 
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expression: 

simple_expression 

( 

$$  =  $1; 

) 

I 

parenthesis_expression 

( 

$$  =  SI; 

) 


simple_expression : 
variable 
{ 

$$  «  $1; 

) 

I 

constant 

! 

$$  =  SI; 

) 

I 

unary_expression 

( 

SS  =  SI; 

1 

I 

arithmetic_expression 

( 

$$  =  SI; 

) 

I 

character_expression 

{ 

SS  -  $1; 

1 

) 

relational_expression 

( 

SS  =  SI; 

1 

I 

logical_expression 

( 

SS  =  SI; 

} 


parent he si s_express ion : 

1  ( 1  expression  ' )  1 

< 

SS  » 

) 


arithnetic_expression: 

expression  '+'  expression  %prec  '♦* 

( 

SS  -  " " ; 

) 

I 

expression  expression  %prec 

( 

SS  = 

} 

I 

expression  expression  %prec 

f 

SS  - 

1 

I 

expression  '/'  expression  %prec  '/' 
( 

) 


SS 
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expression  EXPONENTIATE  expression  %prec  EXPONENTIATE 

( 

$$  = 

} 


character_expression: 

expression  '/'  '/'  expression  %prec  CONCATENATE 

( 

S$  = 

) 


relational  expression: 

expression  RW_EQ  expression  tprec  RW_EQ 

( 

$$  . 

1 

t 

expression  RW_NE  expression  tprec  RW_N£ 

{ 

S$  = 

( 

I 

expression  RW_LT  expression  %prec  RW_LT 

( 

S$  = 
t 
I 

expression  RW_LE  expression  tprec  RW_LE 

( 

SS  = 

1 

I 

expression  RW_GT  expression  %prec  RW_GT 

( 

$$  - 

) 

I 

expression  RW_GE  expression  tprec  RW_GE 

( 

$$  - 

) 


logical_expression: 

expression  RW_AND  expression  tprec  RW_AND 

( 

SS  = 

1 

I 

expression  RW_OR  expression  tprec  RW_OR 

( 

$$  - 

1 

I 

expression  RW_EQV  expression  tprec  RW_EQV 

f 

SS  * 

) 

I 

expression  RW_NEQV  expression  tprec  RW  NEQV 

{ 

SS  » 

) 


unar,  _expression: 

expression  tprec  SIGN 

( 

SS  = 

) 

I 

expression  tprec  SIGN 

( 


SS 


n  it  . 
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) 

RW_NOT  expression  %prec  RW_N0T 
{ 

$$  - 
I 


variable : 

identifier 

( 

S$  =  $1; 

} 

I 

identifier  string_subset 

{ 

S$  =  $1; 

) 

\ 

array 

{ 

$$  =  $1; 

) 


array : 

identifier  • (‘  optional_expression_list  •)' 

( 

SS  =  SI; 

} 

I 

identifier  '('  optionai_expression  list  string  subset 

{ 

SS  =  SI; 

1 


identifier; 

IDENTIFIER 

1 

if  (  enable  ) 

usage_identi f ier (  SI,  usage  ); 
if  (  usage  ==  SET  )  usage  =  REF; 

SS  =  SI; 

) 


optional  expression_list : 
F-  NULL  */ 

I 

expression_list 


expression  list: 

expression 

I 

expression_list  expression 


string_subset : 

'('  optional_expression 


optionai_expression  ')' 


optional  expression: 
r*  NULL  */ 
i 

expression 


constant : 

logical_constant 

{ 
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$$  =  $1; 

) 

I 

character_constant 

( 

SS  »  SI; 
l 
I 

unsigned_numer ical_constant 

f 

$$  =  $1; 

) 


logical_constant : 
RW_TRUE 
( 

SS  - 

1 

I 

RW_FALSE 

( 

SS  = 

} 


character_constant : 
HOLLERITH 
( 

SS  - 

1 

I 

STRING 

( 

$$  = 

1 


unsigned_numerical_constant : 
INTEGER 
{ 

SS  - 

1 

I 

REAL 

{ 

SS  - 

) 

I 

DOUBLE  PRECISION 

< 

SS  = 

1 


SIGN 
SIGN 

executable_statement : 

do_statement 

I 

do_whi le_statement 
I 

end_do_statement 

I 

logical_t  f_statement 

I 

bLoclc  IE  statement 


nume  rical_constant : 

unsigned_numerical_constant 

1 

■+'  unsigned_numerical_constant  %prec 

I 

unsigned_numerical_constant  %prec 


else  statement 
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el se_i f _statement 
I 

end_if  statement 
I 

subset  executable  statement 


do_statement : 

RW_DO  optional_integer  do_identifier  1 =‘  expression_l i st 


do_identifier: 

IDENTIFIER 

( 

if  (  enable  ) 

usage_identi f ier (  SI,  SET  ); 

1 


optional  integer: 

NULL  */ 
I 

INTEGER 


do_while_statement : 

RW_DO_WHILE  '('  expression  ')' 


end_do_statement : 

RW  END  DO 


logical_i f_statement : 

i f_expression  subset_executable_statement 


if_expression: 

RW_IF  • ( *  expression  ')’ 


block_i f_statement : 

RW_IF  1 ('  expression  ') '  RW_THEN 


else_statement : 

RW  ELSE 


else_i f_statement : 

RW_ELSE_IF  ■('  expression  ')'  RW_THEN 


end_i f_statement : 

RW  END  IF 


executable_statement : 
assignment_statement 

assign_statement 

arithmetic_if_statement 

cont inue_statement 

call  statement 


subset 

I 

I 


return  statement 
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unconditional_qo  to_statement 
I 

computed_go_to_statement 

I 

assigned  go_to_statement 
I 

stop_statement 

I 

pause_statement 

I 

io_statement 

assignment_statement : 

{  if  (  usage  ==  REF  )  usage  =  SET;  j  variable  '='  expression 


assign_statement : 

RW  ASSIGN  INTEGER  RW  TO  IDENTIFIER 


arithmet ic_i f_statement : 

RW_IF  '('  expression  ')'  integer_list 


continue_statement : 

RW  CONTINUE 


call_statement : 

RW_CALL  call_identifier 
I 

RW_CALL  call_identifier  opt ional_actual_argument_l i st 


cal l_identi fieri 

IDENTIFIER 

( 

if  (  enable  ) 

add_call  list(  Si  I  I 
I 


opt ional_actual_argument_l ist : 

I 

' ('  (  usage  &  =  -REF;  )  actual_argument_l i st  1  usage  |=  REF;  }  ') ' 


actual_argument_list : 

actual_argument 

I 

actual_argument_list  actual_argument 


actual 


argument : 
expression 
{ 

if  (  enable  ) 

add_actual_argument_li  t (  SI 

1 

actual_argument_al ternate_return 
( 

if  (  enable  ) 

add_actual_arqument_l ist t  "" 

) 


)  ; 


actual_argument_alternate_return : 
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' * '  INTEGER 


ret  u  restatement : 

RW_RETURN  opt ional_expression 


uncondit ional_go_to_statement : 
RW  GO  TO  INTEGER 


computed_go_to_statement : 

RW_GO_TO  integer^! 1st  optional 


assigned_go_to__statement : 

Rw_G°_TO  IDENTIFIER 
I 

RW_GO  TO  IDENTIFIER  opt ional_comma  ' 


integer  list: 

INTEGER 

l 

integer_li st 


INTEGER 


optional  comma: 

/*  NULL  */ 


pause_statement : 

RWPAUSE  optional_expression 


stop_statement : 

RW_STOP  opt ional_expression 

atement : 

open_statetrient 

cl ose_st atement 

inqui re_st atement 

read_st atement 

write_st atement 

print_st atement 

backspace_st atement 

rewind_sc atement 

endfile  statement 


open_st  atement : 

RW  OPEN  ' {'  control  information  iist  ’ 


cl ose_statement : 

RW  CLOSE  ' ('  control  information  iist 


io  st 


I 


comma  expression 


integer_list  ')' 


)  ' 


'  )  ' 
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inqui re_statement : 

RW  INQUIRE  '  ('  control  informal  *c:*.  1. :  st 


read_statement : 

RW_READ  '('  cone  rol_informat  icn_i  i  st  '  )  ’ 

RW_READ  control 

l 

RW_READ  control  *,*  io_iist 

wri  te__statement : 

RW_WRITE  '  ('  cont  rol_i  nf  o  rrr.at ion_l  1st  ') 

print  statement : 

RW_PRINT  control 

RW  PRINT  control  io  list 


backspace_statement : 

RW_BACKSPACE  '('  cont rol_in f o rmat i on_l 1 s 
I 

RW  BACKSPACE  control 


rewmd_statement : 

RW_REWIND  cont roi_inf ormat ion_i i st  ' 

I 

RW  REWIND  control 


endf i le_statement : 

RW^ENDFILE  1 (•  cont rol_i nf ormat i on_l i st 

t 

RW  ENDFILE  control 


information_list: 

control_information 

cont rol_informat ion_l ist  control  inf 


cont roi_in format  ion : 
cent  rol 

I 

IDENTIFIER  expression 


cont  ro 1 : 

variable 

constant 

t 


optional  io_list: 

/•  NULL  */ 

io  list 


io  list: 


io 

i o  list 


io 


)  ' 


option a.  :o  .:st 


opt  icr.a  1  _i  o_  1  ist 


’  )  ‘ 


'  )  ’ 


:mat : on 
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expression 

io_implied_do_list 


io_implied_do_list : 

*('  io_list  io_identif ier  '='  expression_list 


io_identifier: 

IPENTIFIER 

( 

if  (  enable  ) 

usage_ide.  rifier  (  $1,  SET  ); 

) 


format_statement : 

RW  FORMAT 


%% 


FILE:  usage/usage/include/li st . h 


/» 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


#define  LIST  struct  list 
LIST 
( 

char  ‘identifier; 
int  line; 
int  usage; 

LIST  *actual_argument_list; 
LIST  ‘next; 

)  ; 


extern 

extern 

extern 

extern 

extern 

extern 

extern 

extern 

extern 

extern 

extern 

extern 

extern 

extern 


LIST  *end_list<  ); 
void  add_end_list (  ); 

LIST  * f ind_l ist (  ); 

void  add_formal_argument_list (  ); 

void  add_call_list (  ); 

void  add_actual_argument_list (  ); 

void  add_variable_list ( 

void  usage_identif ier (  ); 

void  begin_block(  ); 

void  end_block(  ); 

void  usage_actual_argument_list (  ); 
void  usage_formal_argument_list (  ); 
int  f ind_block_number (  ); 
void  usage  block)  ); 


♦define  MAXIMUM_NUMBER_BLOCK  1024 

extern  char  ‘block [  MAXIMUM_NUMBER_BLOCK  ); 

extern  LIST  *  forma l_argument_l i st [  MAXIMUM_NUM3ER_BL0CK  ]; 

extern  LIST  *variable_list [  MAXIMUM_NUMBER_BLOCK  ]; 

extern  LIST  *call_list[  MAXIMUM_NUMBER_BLOCK  ); 

extern  int  number  block; 


FILE:  usage /usage/ include /usage . h 
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*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦define  REF  0x10000000 
♦define  SET  0x20000000 


FILE:  usage /usage/ library /Makefile 


♦ 

♦  Copyright  1991 

♦  Georgia  Institute  of  Technology 

♦  Computer  Engineering  Research  Laboratory 

♦  Author:  Stephen  R.  Wachtel 

♦ 


CC  =  cc  -g 
INCLUDE  *  ../include 
CFLAGS  -  -IS (INCLUDE) 
LIBRARY  =  library. a 


OBJECTS  =  \ 

duplicate. o  \ 
hollerith.o  \ 
intrinsic. o  \ 
linX_list.o  \ 
main.o  \ 
non_blank.o  \ 
summary. o  \ 
uppercase. o  \ 
yyerror.o  \ 
yygetc.o  \ 
yywrap. o 


S (LIBRARY) : S (OBJECTS) 

ar  crv  S (LIBRARY)  $ (OBJECTS) 
ranlib  S  (LIBRARY) 


.SUFFIXES:  .c  .o 
.  c.  o : 

$<CC)  -c  S  (CFLAGS)  $< 


clean: 

rm  -f  $ (LIBRARY)  S (OBJECTS) 


FILE:  usage/usage/library/duplicate. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


♦include  <stdio.h> 
♦include  <string.h> 
♦include  <malloc.h> 


char  ‘duplicate!  string  ) 
register  char  ‘string; 

{ 

register  char  ‘temporary  =  (char  *)NULL; 

if  (  string  !»  (char  ‘(NULL  ) 

{ 

if  (  (  temporary  -  (char  *)malloc(  strlenl  string  )  +  1  )  )  !=  (char  *)NULL 

strcpyl  temporary,  string  ); 
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else 

fprintf(  stderr,  "ERROR:  duplicate (  %s  )\n",  string  ); 

t 

return (  temporary  ); 

}  /*  duplicate  */ 


FILE:  usage /usage/ library /hoi lerith . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


#include  <stdio.h> 


char  "hollerlth!  string,  delimeter  ) 
register  char  "string; 
register  char  delimeter; 

( 

int  hollerith_length; 

register  int  string_length  =  0; 

sscanf(  string,  "%dh",  £hollerith_length  ); 

string!  string_length++  ]  =  delimeter; 

while  (  hollerith_length  !=  0  ) 

( 

if  (  (  string!  string_length  ]  =  yyinput (  )  )  -=  '\n'  ) 

( 

yyunput (  string!  string_length  ]  ); 
break; 

) 

string  length++; 
hollerTth_length — ; 

) 

string!  string_length++  ]  =  delimeter; 

string!  string_length  ]  =  '\0'; 

return!  string  ); 

)  /*  hollerith  */ 


FILE:  usage /usage / 1 ibrary / i nt r i nsic. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 


extern  char  "duplicate!  ); 
extern  char  "uppercase!  ); 


static  char  *intrinsic_table [  ]  = 
( 

"ABS", 

"ACOS", 

"AIMAG", 

"AINT", 

"ALOG", 

"ALOGIO", 

"AMAXO", 

"AMAX1", 

"AMINO", 

"AMIN1 " , 

"AMOD", 

"ANINT", 

"ASIN", 

"ATAN", 
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"AT AN 2", 

"CABS", 

"CCOS", 

"CEXP", 

"CHAR", 

"CLOG", 

"CMP LX", 

"CONJG", 

"COS", 

"COSH", 

"CSIN", 

"CSQRT", 

"DABS", 

"DACOS", 

■DASIN", 

"DATAN”, 

"DATAN2", 

“DBLE" , 

"DCOS", 

"DCOSH", 

"DDIM" , 

"DEXP", 

"DIM", 

"DINT", 

"DLOG", 

"DLOGIO", 

"DMAX1", 

"DMIN1", 

"DMOD" , 

"DNINT", 

"DPROD", 

"DSIGN" , 

"DSIN", 

"DSINH" , 

“DSQRT”, 

"DTAN", 

"DTANH", 

"EXP", 

"FLOAT", 

"IABS", 

"ICHAR", 

"IDIM”, 

"IDINT", 

"IDNINT", 

"IFIX", 

"INDEX", 

“INT", 

"ISIGN", 

"LEN", 

"LGE" , 

"LGT" , 

"LLE", 

"LLT", 

"LOG", 

"LOGIO", 

“MAX", 

"MAXO”, 

"MAXI", 

"MIN", 

"MINO", 

"MINI", 

"MOD", 

"NINT", 

"REAL", 

"SIGN", 

"SIN", 

"SINH", 

"SNGL" , 

"SORT", 

"TAN", 

"TANH" 

1; 


♦define  INTRINSIC  TABLE  (  sizeofl  intrinsic_table  )  /  sizeofl  char  *  )  ) 


int  intrinsic!  identifier  ) 
register  char  "identifier; 

1 

register  int  low,  high; 
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register  int  middle,  test; 

register  char  ‘temporary  =  duplicate)  identifier  ); 
low  =  0; 

high  *  INTRINSIC_TABLE  -  1; 

uppercase)  temporary  ); 

while  (  low  <=  high  ) 

( 

middle  -  (  low  +  high  )  /  2; 

test  =  strcmp)  temporary,  intrinsic_table [  middle  1  ); 

if  (  test  <  0  ) 

{ 

high  =  middle  -  1; 
continue; 

1 

if  (  test  >  0  ) 

( 

low  =  middle  +  1; 
continue; 

1 

free)  temporary  ); 
return (  1  ) ; 

1 

free)  temporary  ); 
return (  0  ) ; 

1  /*  intrinsic  */ 


FILE:  usage /usage/ library /link_list . c 


/* 

»  Copyright  1991 

*  Georgia  Institute  of  technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

V 


♦include  <stdio.h> 
♦include  <malloc.h> 
♦include  "usage. h" 
♦include  "list.h” 


extern  int  yylineno; 


char  ‘block)  MAXIMUM_NUMBER_BLOCK  ); 

LIST  »formal_argument_list [  MAXIMUM_NUMBER_BLOCK  ); 
LIST  *variable_list[  MAXIMUM_NUMBER_BLOCK  1; 

LIST  *call_list [  MAXIMUM_NUMBER_BLOCK  ); 
int  number  block  «  0; 


LIST  *end_list (  list  ) 
register  LIST  ‘list; 

( 

if  (  list  !«  (LIST  * ) NULL  ) 

( 

while  (  1 i st->next  !=  (LIST  *)NULL  ) 
list  -  list->next; 

) 

return)  list  ); 

)  /*  end  list  */ 


void  add_end_list (  list,  identifier  ) 
register  LIST  “list; 
register  char  ‘identifier; 

( 

register  LIST  ‘temporary  =  (LIST  ‘Imalloc)  sizeof (  LIST  )  ); 
temporary->identif ier  =  identifier; 
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temporary->line  =  yylineno; 
temporary->usage  -  0; 

temporary->actual_argument_list  =  (LIST  "(NULL; 
temporary->next  =  (LIST  "(NULL; 

if  (  "list  ==  (LIST  * ) NULL  ) 

•list  =  temporary; 

el  se 

end_Iist(  'list  ) ->next  =  temporary; 

)  /*  add  end  list  */ 


LIST  *find_list(  list,  identifier  ) 
register  LIST  "list; 
register  char  "identifier; 

( 

while  (  list  (LIST  " ) NULL  ) 
f 

if  (  strempf  list->identifier,  identifier  )  ==  0  ) 
return (  list  ); 

list  *  list->next; 

1 

return!  (LIST  *)NULL  >; 

)  /*  find  list  */ 


void  add_formal_argument_list (  identifier  ) 
register  char  "identifier; 

1 

add_end_list (  sformal_argument_list [  number_block  1,  identifier  ); 
)  /*  add_f ormal_argument_list  */ 


void  add_call_list (  identifier  ) 
register  char  "identifier; 

{ 

add_end_list (  Ccall_list(  number_block  ],  identifier  ); 
1  /*  add  call  list  */ 


void  add_actual_argument_list (  identifier  ) 
register~char  "identifier; 

{ 

add_end_list (  send  list!  call  list[  number_block  ]  ) ->actual_argument_l ist ,  identifier 

)  ; 

}  /*  add_actual_argument_list  */ 


void  add_variable_list (  identifier  ) 
register  char  "identifier; 

{ 

if  (  find_list (  variable_list 1  number_block  ),  identifier  )  ==  (LIST  *)NULL  ) 
add_end  list(  svariable_list (  number_block  ],  identifier  ); 

1  /*  add  variable  list  */ 


void  usage_identifier (  identifier,  usage  ) 
register  char  "identifier; 
register  int  usage; 

( 

register  LIST  "temporary; 

temporary  =  find_list(  formal_argument_list (  number_block  i,  identifier  ); 
if  (  temporary  (LIST  "JNULL  ) 

( 

temporary->usage  |=  usage; 
return; 

) 

add_variable_list (  identifier  ); 

temporary  -  find_list(  variable_list (  number_block  1,  identifier  ); 
if  (  temporary  !-  (LIST  * ) NULL  ) 

{ 

temporary->usage  1=  usage; 
return; 

) 

)  /*  usage_identi f ier  */ 
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void  begin_block(  identifier  ) 
register  char  'identifier; 

( 

block!  number_block  1  =  identifier; 
for-w._a.iyu.nent._iis:.  [  r.ut^er  blow..  ;  *  (Li  Si  *!N'-uu; 
variable_list [  number_block  ]  =  (LIST  *)NULL; 
call  list [  number_block  1  =  (LIST  *)NULL; 

)  /*  begln_block  */ 


void  end_block(  ) 

( 

number_block++; 
1  /*  end  block  */ 


void  usage_actual_argument_list (  block  number,  actual_argument_list  ) 

register  int  block_number; 

register  LIST  'actual_argument_list; 

{ 

register  LIST  'temporary; 

while  (  actual_argument_list  !=  (LIST  *)NULL  ) 

( 

if  (  strcmpt  actual_argument_list->identifier,  ""  )  !=  0  ) 

( 

temporary  =  find_list(  formal_argument_list [  block_number  ], 
actual_argument_list->identif ier  ) ; 

if  (  temporary  ! *  (LIST  *)NULL  ) 

( 

temporary->usage  1=  actual_argument_list->usage; 
actual_argument_list  =  actual_argument_list->next; 
continue; 

1 


temporary  =  find_list(  variable_list [  block_number  1,  actual_argument_list- 
>identifier  ); 

if  (  temporary  !=  (LIST  *)NULL  ) 

1 

temporary->usage  1=  actual_argument_list->usage; 
actual_argument_list  =  actual_argument_list->next; 
continue; 

) 

) 

actual_argument_list  =  actual_argument_iist->next; 

) 

(  /'  usage_actual_argument_list  */ 


void  u3age_formal_argument_list (  actual_argument_list,  formal_argument_l ist  ) 
register  LIST  *actual_argument_list; 
register  LIST  »formal_argument  list; 

( 

while  (  (  actual_argument_list  !=  (LIST  *)NULL  )  SS  (  f ormal_argument_l i st  !=  (LIST 
* ) NULL  )  ) 
f 

if  (  strcmp(  actual_argument_list->identifier,  )  1=  0  ) 

actual_argument_list->usage  |=  formal_argument_list->usage; 

actual_argument_list  =  actual_argument_list->next; 
formal_arguroent_list  =  formal_argument_list->next; 

1 

)  /'  usage_formal_argument_list  */ 


int  f ind_block_number (  identifier  ) 
register  char  'identifier; 

( 

register  int  block_number; 

for  (  block_number  =  0;  block_number  !=  number_block;  block_number++  ) 

( 

if  (  strcmp(  block[  block_number  J,  identifier  )  ==  0  ) 
return!  block_number  ); 

} 

fprintf(  stderr,  "WARNING:  block  %s  not  foundNn",  identifier  ); 
begin  block(  identifier  ); 
end  block (  ) ; 
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return (  number_block  -  1  )  ; 
)  /*  find  block  number  */ 


void  usage  block (  block_number,  actual_argument_list  ) 
register  i*i_  _-ock_numbc* , 
register  LIST  *actual_argument_list; 
t 

register  LIST  “call  =  call_list[  block_numbcr  ] ; 

while  (  call  !=  (LIST  *)NULL  ) 

( 

usage_block(  find_block  number)  call->identifier  ),  call->actual_argument_list  ); 

usage_actual_argument_lTst (  block_number,  call->actual_argument_list  );  ~ 

call  =  call->next; 

) 

usage_formal_argument_list (  actual_argument  list,  formal  argument  list[  block  number  ] 
) ;  _  _  _ 

(  /*  usage_block  */ 


FILE:  usage/usage/library/main.c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 


extern  FILE  *yyin; 
extern  FILE  ‘yyout; 


♦define  PROGRAM  argument [  0  ) 
♦define  INPUT_FILE  argument [  1  ) 
♦define  OUTPUT_FILE  argument!  2  ] 


int  main(  number_argument,  argument  ) 
int  number_argument; 
char  ‘argument!  ]; 

{ 

if  (  number_argument  ==  1  ) 

( 

yyin  =  stdin; 
yyout  *  stdout; 

yyparse (  ); 
exit  (  0  ) ; 

} 


if  (  number_argument  -=  3  ) 

( 

if  (  (  yyin  =  fopenl  INPUT  FILE,  "r"  )  )  ==  (FILE  *)NULL  ) 

( 

fprintf(  stderr,  "%s:  ERROR  -  unaole  to  open  input  file  '%s'\n", 
INPUT_FILE  ); 

exit (  -1  ) ; 


1 

if  (  (  yyout  =  fopen (  OUTPUT  FILE,  "wM  )  )  •=  (FILE  *)NULL  ) 

( 

fprintf(  stderr,  "%s:  ERROR  -  unable  to  open  output  file  '%s'\n", 
OUTPUT_FILE  ) ; 

exit  (  -1  ) ; 

1 


PROGRAM, 


PROGRAM, 


yyparse (  ) ; 
exit (  0  ) ; 


fprintf(  stderr. 


usage:  %s  kinput  file>  <output  file>\n",  PROGRAM  ) ; 
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exit (  0  ) ; 
}  /*  main  */ 


FILE :  usage /usage/ libra ry/non_blank . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


((include  <string.h> 


char  *non_blank (  string  ) 
register  char  ‘string; 

( 

register  int  offset; 
register  int  length; 


length  «  strlen(  string  )  -  1; 
while  (  (  string!  length  ]  ==  ' 
string!  length —  ]  =  ' \0‘; 

offset  »  0; 

while  (  (  string!  offset  ]  ==  ' 
string!  offset++  ]  =  ' \0'; 


)  ss  (  string!  length 


)  ss  (  string!  offset 


strcpyl  string,  Sstring!  offset  ]  ); 


if  (  strlen!  string  )  !=  0  ) 

return!  string  ); 

else 

return (  0  ) ; 

)  /»  non_blank  •/ 


•\0-  )  ) 

•\0'  )  ) 


FILE:  usage /usage /library /summary . c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


((include  <stdio.h> 
((include  "usage.h" 
((include  "list.h" 


extern  FILE  *yyin; 
extern  FILE  *yyout; 


void  print_list(  file,  string,  list  ) 
register  FILE  ‘file; 
register  char  ‘string; 
register  LIST  ‘list; 

( 

int  column  =  strlen!  string  ); 

fprintf!  file,  "%s",  string  ); 

while  (  list  ! »  (LIST  ‘(NULL  ) 

( 

fprintf!  file,  "%s",  list->identif ier  ); 
column  +«  strlen!  1 i st->ident i f ier  ); 

if  !  iist-^usage  !=  0  ) 

( 

fprintf (  file,  " ( "  ) ; 
column++; 


if  (  (  list->usage  S  SET  ) 


SET  ) 


if  (  (  list->usage  t  REF  ) 


REF  ) 
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( 

fprintff  file,  "S”  ); 
column++; 

1 

if  (  (  list->usage  i  REr  )  ==  REF  ) 

fprintff  file,  "R”  ); 
column++; 

) 

fprint f  t  file,  ” } "  ) ; 
column ' 

1 

if  {  list->next  !=  (LIST  -/NULL  ) 

{ 

fprintff  file,  "  ); 
column++ ; 

Idefine  MAXIMUM_COLUMN  79 

if  (  column  >=  MAXIMUM_COLUMN  ) 

{ 

fprintff  file,  "\n"  ); 
fprintf  (  file,  "\t\t"  ) ; 
column  ’  8; 

1 


list  •  list->next; 

> 

1  /*  print_list  */ 


void  print_call  list (  file,  list,  usage  ) 
register  FILE  ‘file; 
register  LIST  ‘list; 
register  int  usage; 

( 

register  char  string!  256  ]; 

while  (  list  !»  (LIST  *>NULL  ) 

( 

if  (  (  usage  ««  0  )  | |  (  usage  list->usage  )  ) 

{ 

sprintff  string,  "  line  %d,  call  tsf",  list->line,  list->identi f ier  ) 
print_list(  file,  string,  list->actual_argument_list  >; 
fprintff  file,  ")\n"  ); 

1 

list  =  list->next; 

) 

)  /*  print_call_list  V 


void  print_variable_list (  file,  block_number  ) 
register  FILE  ‘file; 
register  int  block_number; 

( 

register  LIST  *list  »  variable_list [  block_numoer  ]; 

while  (  list  !=  (LIST  *)NULL  ) 
f 

if  (  (  list->usage  i  SET  )  ==  SET  ) 

fprintff  file,  "%s  S\n",  list->identi f ier  >; 

else 

{ 

fprintff  file,  ”%s  R\nM,  1 ist->ident i f ier  ); 

i 

list  =  list->next; 

) 

}  /*  print_variable_list  */ 


void  summary!  ) 

( 

char  string!  256  ); 
register  int  block_number; 
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usage_block(  0,  0  ); 
tifdef  DEBUG 

for  (  block_number  =  0;  block_number  !=  number_block;  block  number++  ) 
( 

SDrintf!  string.  block[  block_numLer  )  ); 

print_list (  yyout,  string,  formal_argument_list [  block_number  )  ); 
fprintf!  yyout,  ")\n"  ); 

print_call_list (  yyout,  call_list[  block_number  i,  0  ); 
print_variable_list (  yyout,  block_number  ); 
fprintf!  yyout,  "\n"  ); 

) 

♦  else 

print_variable_list (  yyout,  0  ); 

♦endif 

}  /*  summary  */ 


FILE:  usage/usage/1 ibrary /uppercase. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Kachtel 
*/ 


cha.  *UDcercase(  string  ) 
register  c.  ar  'string; 

i 

register  int  index  =  0; 

while  (  stringi  index  ]  !=  '\0'  ) 

f 

string!  index  ]  ■=  toupper(  string!  index  ]  ); 
index++; 

1 

return!  string  ); 

)  /*  uppercase  */ 


FILE:  u sage /usage /library/y ye rror .  c 


/* 

*  Copyright  1391 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


♦include  <stdio.h> 


extern  int  yylineno; 


void  yyerror!  string  ) 
register  char  'string; 

( 

fprintfl  stderr,  "line  %d,  %s\n",  yylineno,  string  )  ; 

exit!  -1  )  ; 

)  /*  yyerror  */ 


FILE:  usage/usage/1 ibrary /yygetc. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 

*/ 
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((include  <sCdio.h> 
((include  <ctype.h> 


extern  int  yvl ineno; 


int  tab(  length  ) 
register  int  length; 

{ 

while  (  length —  !=  0  ) 
yyunput <  '  1  )  ; 

return (  '  '  )  ; 

)  /*  tab  */ 


int  yygetc!  file  ) 
register  FILE  'file; 
{ 

int  c; 

int  column!  6  ]; 
loop: 


if 

(  (  c  =  getc! 

file  )  ) 

==  '\f 

) 

c  »  tab (  6  )  ; 

if 

(  c  !-  ' \n '  ) 

return (  c  ) ; 

if 

(  (  column!  0 

]  =  getc! 

file  ) 

)  !- 

goto  abort_0 

if 

(  (  column!  1 

)  =  getc ( 

file  ) 

)  !  = 

goto  abortl 

if 

(  (  column!  2 

1  =  getc! 

file  ) 

)  !  = 

goto  abort_2 

if 

(  !  column [  3 

J  -  getc ( 

file  ) 

)  !  = 

goto  abort_3 

if 

(  (  column!  4 

1  =>  getc! 

file  ) 

)  !  = 

goto  abort_4 

if 

(  i* space!  c" 

lumn[  5  ) 

=  getc! 

file 

goto  abort_5 

yylineno++; 

goto  loop; 

abort  5: 

if  (  column!  5  ]  *=  '\t'  ) 
tab!  1  ); 
else 

i 

yyunput!  column!  5  ]  ); 
if  (  column!  5  1  ««  *\n’  ) 
yylineno++; 

1 


abort_4 : 

if  (  column!  4  ]  ' \t '  ) 

tab (  2  )  ; 
else 
( 

yyunput!  column!  4  1); 
if  (  column!  4  1  ==  ' \n'  ) 
yylineno++; 

> 


abort_3 : 

if  (  column!  3  1  "  '\t'  ) 
tab!  3  ); 
else 
( 

yyunput!  column!  3  )  ); 
if  (  column!  3  )  =»  '\n'  ) 
yylineno++; 

} 


abort  2: 

if  (  column!  2  )  ==  '\t'  ) 
tab (  4  ) ; 
else 
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{ 

yyunput (  column [  2  ]  ); 

if  (  column!  2  ]  ==  '\n'  ) 
yyl ineno++; 

) 

abort_l : 

if  (  column!  1  J  ==  ■  \t‘  ) 
tab (  5  ) ; 

else 

{ 

yyunput!  column!  11); 
if  (  Column!  1  ]  =»  ’ \n'  ) 
yylineno++; 

1 

abort  _0 : 

if  (  column!  0  ]  ==  ' \t‘  ) 
tab (  6  ) ; 

else 

( 

yyunput!  column!  0  1  )  ; 
if  (  column!  0  1  ==  '\n'  ) 
yylineno++; 

) 

return (  c  ) ; 

)  /*  yygetc  */ 


FILE:  usage/usage/library/yywrap. c 


/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 


int  yywrap!  ) 

( 

return (  1  ) ; 
)  /*  yywrap  */ 


FILE:  usage/usage/scanner . 1 


*! 

/* 

*  Copyright  1991 

*  Georgia  Institute  of  Technology 

*  Computer  Engineering  Research  Laboratory 

*  Author:  Stephen  R.  Wachtel 
*/ 

%) 


%a  10000 
%e  10000 
H  10000 
tn  10000 
to  10000 

%p  10000 


a  [aA] 
b  [bB  J 
c  [  cC  1 
d  (dD) 
e  feE) 
f  C  fF) 
g  EgG] 
h  [  hH  1 
i  (ill 
j  E  JJ1 
k  [JcK  J 
1  E1LI 
m  [mMl 
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n  [  nN  1 
o  [oO] 
P  tpP  ] 
q  [  ad 
r  [rRl 
s  [sS] 
t  [tT] 
u  [uU] 
v  ( vV) 
w  [wW] 
x  [xX] 

y  tyvi 

2  [ZZI 


%( 

((include  "grammar. h" 
extern  char  *yylval; 


♦undef  YYLMAX 
{define  YYLMAX  (256*20) 


extern  char 
extern  char 
extern  char 
extern  char 
%! 


duplicate  (  ) 
hollerith!  ) 
non_blan)c  (  ) 
uppercase!  ) 


%% 


A [ \*cC ] . * [ \n]  I 
Al\  1  * [ \ n ]  { 
t i fdef  DEBUG 
ECHO; 

#endi f 

yylval  -  duplicate  (  yytext  ); 
return!  COMMENT  ); 

) 


t\  1  ( 

#ifdef  DEBUG 
ECHO; 

#endi f 

/*  return!  ' \  '  )  */; 

) 


[ \*  1  ( 

#i fdef  DEBUG 
ECHO; 

#endi f 

return (  •  \S  '  ) ; 

1 


[\  (1  ( 
difdef  DEBUG 
ECHO; 
lendi f 

return (  ' \  ( ■  ) ; 

1 


[\>  1  1 
lifdef  DEBUG 
ECHO; 
lendi  f 

return (  ' \) '  ) ; 

> 


IN*)  f 
#ifdef  DEBUG 
ECHO; 
#endi f 


return (  ■ \* '  ) ; 
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} 


[\*][\*1  < 
lifdef  DEBUG 
ECHO; 
lendif 

return  (  EXPONENTIATE  ); 

} 


C\  +  l  t 
lifdef  DEBUG 
ECHO; 
lendif 

return (  • \+ •  ) ; 

1 


C\.  1  { 

lifdef  DEBUG 
ECHO; 
lendif 

return (  •  \  ,  •  ) ; 

) 


[\-l  { 

lifdef  DEBUG 
ECHO; 
lendif 

return (  ' '  > ; 

} 


C\- 3  ( 

lifdef  DEBUG 
ECHO; 
lendif 

return (  ' \ '  ) ; 

) 


L  x/1  ( 

lifdef  DEBUG 
ECHO; 
lendif 

return!  ■ \/'  ); 

1 


[\ :  1  { 
lifdef  DEBUG 
ECHO; 
lendif 

return  (  • \ s  *  ) ; 

1 


[\  =  ]  { 
lifdef  DEBUG 
ECHO; 
lendif 

return (  ' '  ) ; 

1 


[\n]  ( 

lifdef  DEBUG 
ECHO; 
lendi  f 

/*  return!  '\n'  )  */; 

I 


[\tl  ( 
lifdef  DEBUG 
ECHO; 
lend1  f 

/*  return!  '\t'  )  */; 

) 
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l\.Ha)(n)(dH\.l  ( 

#ifdef  DEBUG 
ECHO; 
lendif 

return (  RW_AND  ) ; 

1 


l\.l<«Hq>[\.)  1 

lifdef  DEBUG 
ECHO; 

#endif 

return (  RW_EQ  ); 

} 


[\.J<e((q}{vH\.l  ( 

lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_EQV  ) ; 

} 


[\.l  (fHa)UHsKe)  (\.)  { 

lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_FALSE  ) ; 

) 


[\.Hql(«l[\.l  ( 

lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_GE  ) ; 

1 


t\.) Iglft) [\.]  < 
lifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_GT  ) ; 

) 


[\.l  (Die)  [\.l  ( 
lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_LE  ); 

1 


[\.  ]  <  X  Ht  )[\ .  ]  { 
lifdef  DEBUG 
ECHO; 
lendi f 

return (  RW_LT  ) ; 

) 


[\. ) (n) (e) [S. 1  ( 
lifdef  DEBUG 
ECHO; 
lendi  f 

return (  RW_NE  ); 

1 


[ \ - 1 Inlleliql (v) [\.]  { 

lifdef  DEBUG 
ECHO; 
lendi  f 


return!  RW_NEQV  ); 
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[\.Hnl(o|(t)[\.]  { 

#ifdef  DEBUG 
ECHO; 

#endif 

return (  RW_NOT  ); 

) 


[\.](o){r)(\  ;  { 

DEBUG 

ECHO; 

#endif 

return (  RW_OR  ) ; 

1 


[\.|ltHr)(a)|e}[\.l  { 

lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_TRUE  ); 

1 


lal(sHslli)lgHn)  ( 

#ifdef  DEBUG 
ECHO; 

#endi f 

return  (  RW_ASSIGN  ) ; 

) 


(bHaHcHMisKpl(aKcHe)  ( 
#i fdef  DEBUG 
ECHO; 

#endif 

return  (  RW_BACKSPACE  ) ; 

) 


(bHlHo)fcHkm  l*(dl(a)(tKa}  { 
#i fdef  DEBUG 
ECHO; 

#endif 

return  (  RW_BLOCK_DATA  ); 

) 


(cKaMl)lU  { 

#ifdef  DEBUG 
ECHO; 

#endi f 

return (  RW_CALL  ); 

) 


IcKhllallrUalioKtHeHr)  ( 
#ifdef  DEBUG 
ECHO; 

Kendi f 

return (  RW_CHARACTER  ); 

) 


(clllHo)(5||e)  ( 

#ifdef  DEBUG 
ECHO; 

#endi f 

return)  RW_CLOSE  ); 

1 


{ c } (o) (m) (m) (o) (n)  ( 

#ifdef  DEBUG 
ECHO; 

#endi  f 

return (  RW_COMMON  ) ; 

> 
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(clloHmUplUHellx)  ( 

Iifdef  DEBUG 
ECHO; 
lendif 

return (  RW_COMPLEX  )  ; 

1 


(cHol|nllt)(lHn!(uHe)  ( 
Iifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_CONTINUE  ) ; 

1 


Idl(aHtKa)  ( 

Iifdef  DEBUG 
ECHO; 
lendif 

return (  RW_DATA  ) ; 

1 


(d)(iHmHe}ln)(s)(iHoKnl  t 
Iifdef  DEBUG 
ECHO; 
lendif 

return {  RW_DIMENSION  ) ; 

) 


{d )  { o l  { 

Iifdef  DEBUG 
ECHO; 
lendif 

return (  RW_DO  ) ; 

1 


(dHoMuHbHl)(e)[\  1  *  (pH  r  He)  <c)  ( i>(  s)  (  i )  (o>  (n(  ( 

Iifdef  DEBUG 
ECHO; 
lendif 

return!  RW_DOUBLE_PRECISION  ); 

1 


(e)(l!(s| (e)  ( 

Iifdef  DEBUG 
ECHO; 
lendif 

return!  RW_ELSE  ); 

} 


(elUlliHel  (\  l*(iKf)  ( 
Iifdef  DEBUG 
ECHO; 
lendif 

return (  RW_ELSE_IF  ) ; 

1 


lellnHd]  { 

Iifdef  DEBUG 
ECHO; 
lendif 

return (  RW_END  ) ; 

} 


(e)!n)!d)[\  l*(il(f)  { 
Iifdef  DEBUG 
ECHO; 
lendif 

return!  RW_END_IF  ); 

) 


(e|(nKdHf|(i|(lHe)  ( 
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lifdef  DEBUG 
ECHO; 

Iendif 

return  (  RWJENDFILE  ); 

> 


(eHnlltllrUy)  { 

♦ifdef  DEBUG 
ECHO; 

Iendif 

return (  RW_ENTRY  ) ; 

} 


(e|(q|(ulUH»)|a)(l|(eKnHc)(e)  { 
lifdef  DEBUG 
ECHO; 

Iendif 

return (  RW_EQUI VALENCE  ) ; 

} 


leUxHtHeKrllnHaHl)  t 
♦ifdef  DEBUG 
ECHO; 

Iendif 

return  (  RW_EXTERNAL  ) ; 

1 


(f|(oKr)(m]{a)(t).*  { 

I ifdef  DEBUG 
ECHO; 

Iendif 

yylval  =  duplicate (  yytext  ); 
return (  RW_FORMAT  )  ; 

) 


(f)|u)fn)|c)|t)|iHoHn)  { 
♦ifdef  DEBUG 
ECHO; 

Iendif 

return (  RW_FUNCTION  ) ; 

) 


(g)(o) [\  ] »(t) (of  { 
lifdef  DEBUG 
ECHO; 

Iendif 

return  (  RW_GO_TO  ) ; 

) 


(  i  1  (  f )  ( 
lifdef  DEBUG 
ECHO; 

♦endi f 

return!  RW_IF  ); 

) 


(illniHpHlUiKcHiKtl  { 
lifdef  DEBUG 
ECHO; 
tend! f 

return!  RW_IMPLICIT  ); 

) 


liHnHc)(l)|uHd)(e)  { 
lifdef  DEBUG 
ECHO; 
lendi f 

return  (  RW_INCLUDE  ) ; 

) 


(i|(n)(q)(u|(i)fr)(e)  { 
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#ifdef  DEBUG 
ECHO; 
lendif 

return (  RW_INQUIRE  ); 

) 


{IHnHtl  {e|  {gl  (e|<r)  { 

lifdef  DEBUG 
ECHO; 

#endif 

return (  RW_INTEGER  ) ; 

I 


(i|(n)(t)|r){l|{n!{sHil(c)  { 

#ifdef  DEBUG 
ECHO; 
lendif 

return (  RW_INTRINSIC  ); 

1 


{11 { o  > (g){i){c| (a) {XI  { 
#ifdef  DEBUG 
ECHO; 
tendlf 

return (  RWJLOGICAL  ) ; 

1 


(n|{aHm)(e)(lHi)(sHt)  { 
lifdef  DEBUG 
ECHO; 
tend! f 

return (  RW_NAMELIST  ); 

1 


(o|{p|{e|{n|  { 

lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_OPEN  ) ; 

I 


IpHaHrHaHm)  <e)  (t)  (elfr)  { 
lifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_PARAMETER  ) ; 

I 


(pllallullsllel  { 
lifdef  DEBUG 
ECHO; 
lendi f 

return  (  RW_PAUSE  ; 

1 


(p)(rHi)ln){tl  { 
lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_PRINT  ) ; 

1 


{pHrlloUgHrKaHml  { 
lifdef  DEBUG 
ECHO; 
lendif 

return (  RW_PROGRAM  ); 

) 


{ r| (e) (a) (d|  { 

lifdef  DEBUG 


18.  Appendix  M:  usage  program  source 
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ECHO; 
lendi f 

return)  RW_READ  ); 

) 


IrlfellaHU  ( 
lifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_REAL  ) ; 

) 


(rHeMtHu)lrHnl  ( 

#i fdef  DEBUG 
ECHO; 
lendif 

return (  RW_RETURN  ) ; 

) 


{ r}{e){w) ( i) (n) ( d >  ( 
lifdef  DEBUG 
ECHO; 
iendi f 

return  (  RW_REWIND  ) ; 

) 


(s) (a) (v) (el  ( 

# i f de  f  DEBUG 
ECHO; 

#endif 

return)  RWSAVE  ); 

} 


(sl(t)(o) (p)  ( 

#ifdef  DEBUG 
ECHO; 

#endif 

return)  RW_STOP  ); 

} 


(sHuHbHrHo){u){tHi){n){e)  ( 
#ifdef  DEBUG 
ECHO; 

#endif 

return)  RW_SUBROUTINE  ); 

1 


ltHh){e)(n)  ( 
lifdef  DEBUG 
ECHO; 
lendi  f 

return)  RW_THEN  ); 


(tl)ol  ) 
lifdef  DEBUG 
ECHO; 
lendif 

return  (  RW_TO  ) ; 

) 


Iw)lr)liHtl(e)  ( 
lifdef  DEBUG 
ECHO; 
lendif 

return)  RW_WRITE  ); 

) 


(uHn)ldl(eHfl(iHnHeHd)  ( 
lifdef  DEBUG 
ECHO; 
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♦endif 

return (  RW_UNDEFINED  ); 

1 


[ ta-zA-Z ) [_a-zA-Z0-9] *  ( 

♦ ifdef  DEBUG 
ECHO; 

♦endif 

yylval  =  duplicate (  uppercase (  yytext  )  ); 
return!  IDENTIFIER  >; 

1 


^[0-9  ] [0-9  1 [0-9  ] [0-9  ] [0-9  ] (\  ]  ( 

♦ ifdef  DEBUG 
ECHO; 

♦endif 

yylval  *  duplicate!  non_blank(  yytext  )  ); 
return (  LABEL  ) ; 
t 


[0-91+  I 

[0—9] +/\. [a-zA-Z]+\.  { 

♦ifdef  DEBUG 
ECHO; 

#endif 

yylval  =  duplicate!  yytext  ); 
return!  INTEGER  ); 

1 


[ 0-9] +\ . [0-9] * ( [eE]  [\+\-]?[0-9]+>?  I 
[0-9] *\.  [0-9]  +  ([eE]  [\+\-]  ?[0-9]+)  ?  I 
{0-9] + ( [eE] [\+\-l?[0-9]+>? < 

♦ifdef  DEBUG 
ECHO; 

♦endif 

yylval  *  duplicate!  yytext  ) ; 
return (  REAL  ) ; 

) 


[0-9] +\. [0-91  * ( [dD]  [\  +  \-l ? [0-91+1 ?  I 
[0-9J  [0-9J+  ([dDl  [\  +  \-J  ? C0-91  +)  ?  I 

[ 0 - 9 1  +  ( [ dD 1  [\  +  \-l ? [0-9] +) ?  { 

♦ifdef  DEBUG 
ECHO; 

♦endif 

yylval  =  duplicate!  yytext  ); 
return  !  DOUBLE_PRECISION  ) ; 

1 


\ ' [-\ ' ] *\ ’  I 
\"[A\")*\-  ( 

♦ifdef  DEBUG 
ECHO; 

♦endi f 

yytext[  0  ]  =  ■ \ ; 

yytext [  strlen!  yytext  )  -  1  ]  =  ' \"*; 
yylval  *  duplicate!  yytext  ); 
return!  STRING  ); 

I 


( 0-9] + [hH ]  { 

♦ifdef  DEBUG 
ECHO; 

♦endif 

yylval  =  duplicate!  hollerith!  yytext,  *\"’  )  ); 
return!  HOLLERITH  ); 

1 


